August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-optparse-generic for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-optparse-generic for openSUSE:Factory checked in at 2017-08-31 20:57:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-optparse-generic (Old) and /work/SRC/openSUSE:Factory/.ghc-optparse-generic.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-optparse-generic" Thu Aug 31 20:57:42 2017 rev:4 rq:513444 version:1.2.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-optparse-generic/ghc-optparse-generic.changes 2017-05-06 18:28:49.678199194 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-optparse-generic.new/ghc-optparse-generic.changes 2017-08-31 20:57:42.648901391 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:54 UTC 2017 - psimons(a)suse.com + +- Update to version 1.2.2. + +------------------------------------------------------------------- Old: ---- optparse-generic-1.1.5.tar.gz New: ---- optparse-generic-1.2.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-optparse-generic.spec ++++++ --- /var/tmp/diff_new_pack.fZq39T/_old 2017-08-31 20:57:43.328805862 +0200 +++ /var/tmp/diff_new_pack.fZq39T/_new 2017-08-31 20:57:43.344803615 +0200 @@ -18,7 +18,7 @@ %global pkg_name optparse-generic Name: ghc-%{pkg_name} -Version: 1.1.5 +Version: 1.2.2 Release: 0 Summary: Auto-generate a command-line parser for your datatype License: BSD-3-Clause @@ -26,6 +26,7 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-Only-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-optparse-applicative-devel BuildRequires: ghc-rpm-macros ++++++ optparse-generic-1.1.5.tar.gz -> optparse-generic-1.2.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-generic-1.1.5/optparse-generic.cabal new/optparse-generic-1.2.2/optparse-generic.cabal --- old/optparse-generic-1.1.5/optparse-generic.cabal 2017-04-12 18:32:44.000000000 +0200 +++ new/optparse-generic-1.2.2/optparse-generic.cabal 2017-07-14 21:21:28.000000000 +0200 @@ -1,5 +1,5 @@ Name: optparse-generic -Version: 1.1.5 +Version: 1.2.2 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3 @@ -27,8 +27,9 @@ system-filepath >= 0.3.1 && < 0.5 , text < 1.3 , transformers >= 0.2.0.0 && < 0.6 , - optparse-applicative >= 0.12.0 && < 0.14, - time >= 1.5 && < 1.7 , + Only < 0.2 , + optparse-applicative >= 0.12.0 && < 0.15, + time >= 1.5 && < 1.9 , void < 0.8 , bytestring < 0.11, semigroups >= 0.5.0 && < 0.19 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-generic-1.1.5/src/Options/Generic.hs new/optparse-generic-1.2.2/src/Options/Generic.hs --- old/optparse-generic-1.1.5/src/Options/Generic.hs 2017-04-12 18:32:44.000000000 +0200 +++ new/optparse-generic-1.2.2/src/Options/Generic.hs 2017-07-14 21:21:28.000000000 +0200 @@ -237,12 +237,37 @@ -- > In an equation for ‘parseRecord’: -- > parseRecord = Options.Generic.$gdmparseRecord -- > In the instance declaration for ‘ParseRecord TheTypeOfYourRecord’ +-- +-- You can customize the library's default behavior using the +-- `parseRecordWithModifiers` utility, like this: +-- +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Options.Generic +-- > +-- > data Example = Example { foo :: Int, bar :: Double } +-- > deriving (Generic, Show) +-- > +-- > modifiers :: Modifiers +-- > modifiers = defaultModifiers +-- > { shortNameModifier = firstLetter +-- > } +-- > +-- > instance ParseRecord Example where +-- > parseRecord = parseRecordWithModifiers modifiers +-- > +-- > main = do +-- > x <- getRecord "Test program" +-- > print (x :: Example) module Options.Generic ( -- * Parsers getRecord + , getWithHelp , getRecordPure , unwrapRecord + , unwrapWithHelp , unwrapRecordPure , ParseRecord(..) , ParseFields(..) @@ -253,6 +278,7 @@ , parseRecordWithModifiers , defaultModifiers , lispCaseModifiers + , firstLetter -- * Help , type (<?>)(..) @@ -279,8 +305,10 @@ import Data.List.NonEmpty (NonEmpty((:|))) import Data.Proxy import Data.Text (Text) +import Data.Tuple.Only (Only(..)) import Data.Typeable (Typeable) import Data.Void (Void) +import Data.Foldable (foldMap) import Filesystem.Path (FilePath) import GHC.Generics import Prelude hiding (FilePath) @@ -327,6 +355,8 @@ -- ^ Help message -> Maybe Text -- ^ Field label + -> Maybe Char + -- ^ Short name -> Parser a default parseField :: (Typeable a, Read a) @@ -334,18 +364,21 @@ -- ^ Help message -> Maybe Text -- ^ Field label + -> Maybe Char + -- ^ Short name -> Parser a - parseField h m = do + parseField h m c = do let metavar = map toUpper (show (Data.Typeable.typeOf (undefined :: a))) case m of Nothing -> do let fs = Options.metavar metavar - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h Options.argument auto fs Just name -> do let fs = Options.metavar metavar <> Options.long (Data.Text.unpack name) - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h + <> foldMap Options.short c Options.option auto fs {-| The only reason for this method is to provide a special case for @@ -357,8 +390,10 @@ -- ^ Help message -> Maybe Text -- ^ Field label + -> Maybe Char + -- ^ Short name -> Parser [a] - parseListOfField h m = many (parseField h m) + parseListOfField h m c = many (parseField h m c) instance ParseField Bool instance ParseField Double @@ -373,71 +408,75 @@ parseField = parseHelpfulString "STRING" instance ParseField Char where - parseField h m = do + parseField h m c = do let metavar = "CHAR" let readM = do s <- Options.readerAsk case s of - [c] -> return c - _ -> Options.readerAbort Options.ShowHelpText + [ch] -> return ch + _ -> Options.readerAbort Options.ShowHelpText case m of Nothing -> do let fs = Options.metavar metavar - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h Options.argument readM fs Just name -> do let fs = Options.metavar metavar <> Options.long (Data.Text.unpack name) - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h + <> foldMap Options.short c Options.option readM fs parseListOfField = parseHelpfulString "STRING" instance ParseField Any where - parseField h m = Any <$> parseField h m + parseField h m c = Any <$> parseField h m c instance ParseField All where - parseField h m = All <$> parseField h m + parseField h m c = All <$> parseField h m c -parseHelpfulString :: String -> Maybe Text -> Maybe Text -> Parser String -parseHelpfulString metavar h m = +parseHelpfulString + :: String -> Maybe Text -> Maybe Text -> Maybe Char -> Parser String +parseHelpfulString metavar h m c = case m of Nothing -> do let fs = Options.metavar metavar - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h Options.argument Options.str fs Just name -> do let fs = Options.metavar metavar <> Options.long (Data.Text.unpack name) - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h + <> foldMap Options.short c Options.option Options.str fs instance ParseField Data.Text.Text where - parseField h m = Data.Text.pack <$> parseHelpfulString "TEXT" h m + parseField h m c = Data.Text.pack <$> parseHelpfulString "TEXT" h m c instance ParseField Data.ByteString.ByteString where - parseField h m = fmap Data.Text.Encoding.encodeUtf8 (parseField h m) + parseField h m c = fmap Data.Text.Encoding.encodeUtf8 (parseField h m c) instance ParseField Data.Text.Lazy.Text where - parseField h m = Data.Text.Lazy.pack <$> parseHelpfulString "TEXT" h m + parseField h m c = Data.Text.Lazy.pack <$> parseHelpfulString "TEXT" h m c instance ParseField Data.ByteString.Lazy.ByteString where - parseField h m = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m) + parseField h m c = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m c) instance ParseField FilePath where - parseField h m = Filesystem.decodeString <$> parseHelpfulString "FILEPATH" h m + parseField h m c = Filesystem.decodeString <$> parseHelpfulString "FILEPATH" h m c instance ParseField Data.Time.Calendar.Day where - parseField h m = do + parseField h m c = do let metavar = "YYYY-MM-DD" case m of Nothing -> do let fs = Options.metavar metavar - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h Options.argument iso8601Day fs Just name -> do let fs = Options.metavar metavar <> Options.long (Data.Text.unpack name) - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h + <> foldMap Options.short c Options.option iso8601Day fs where iso8601Day = Options.eitherReader @@ -461,8 +500,11 @@ -- ^ Help message -> Maybe Text -- ^ Field label + -> Maybe Char + -- ^ Short name -> Parser a - default parseFields :: ParseField a => Maybe Text -> Maybe Text -> Parser a + default parseFields + :: ParseField a => Maybe Text -> Maybe Text -> Maybe Char -> Parser a parseFields = parseField instance ParseFields Char @@ -480,46 +522,47 @@ instance ParseFields Data.Time.Calendar.Day instance ParseFields Bool where - parseFields h m = + parseFields h m c = case m of Nothing -> do let fs = Options.metavar "BOOL" - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h Options.argument auto fs Just name -> do Options.switch $ Options.long (Data.Text.unpack name) - <> maybe mempty (Options.help . Data.Text.unpack) h + <> foldMap (Options.help . Data.Text.unpack) h + <> foldMap Options.short c instance ParseFields () where - parseFields _ _ = pure () + parseFields _ _ _ = pure () instance ParseFields Any where - parseFields h m = (fmap mconcat . many . fmap Any) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap Any) (parseField h m c) instance ParseFields All where - parseFields h m = (fmap mconcat . many . fmap All) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap All) (parseField h m c) instance ParseField a => ParseFields (Maybe a) where - parseFields h m = optional (parseField h m) + parseFields h m c = optional (parseField h m c) instance ParseField a => ParseFields (First a) where - parseFields h m = (fmap mconcat . many . fmap (First . Just)) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap (First . Just)) (parseField h m c) instance ParseField a => ParseFields (Last a) where - parseFields h m = (fmap mconcat . many . fmap (Last . Just)) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap (Last . Just)) (parseField h m c) instance (Num a, ParseField a) => ParseFields (Sum a) where - parseFields h m = (fmap mconcat . many . fmap Sum) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap Sum) (parseField h m c) instance (Num a, ParseField a) => ParseFields (Product a) where - parseFields h m = (fmap mconcat . many . fmap Product) (parseField h m) + parseFields h m c = (fmap mconcat . many . fmap Product) (parseField h m c) instance ParseField a => ParseFields [a] where parseFields = parseListOfField instance ParseField a => ParseFields (NonEmpty a) where - parseFields h m = (:|) <$> parseField h m <*> parseListOfField h m + parseFields h m c = (:|) <$> parseField h m c <*> parseListOfField h m c {-| Use this to annotate a field with a type-level string (i.e. a `Symbol`) representing the help description for that field: @@ -532,18 +575,18 @@ newtype (<?>) (field :: *) (help :: Symbol) = Helpful { unHelpful :: field } deriving (Generic, Show) instance (ParseField a, KnownSymbol h) => ParseField (a <?> h) where - parseField _ m = Helpful <$> - parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m + parseField _ m c = Helpful <$> + parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c instance (ParseFields a, KnownSymbol h) => ParseFields (a <?> h) where - parseFields _ m = Helpful <$> - parseFields ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m + parseFields _ m c = Helpful <$> + parseFields ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c instance (ParseFields a, KnownSymbol h) => ParseRecord (a <?> h) {-| A 1-tuple, used solely to translate `ParseFields` instances into `ParseRecord` instances -} -newtype Only a = Only a deriving (Generic, Show) +newtype Only_ a = Only_ a deriving (Generic, Show) {-| This is a convenience function that you can use if you want to create a `ParseRecord` instance that just defers to the `ParseFields` instance for @@ -572,7 +615,11 @@ default parseRecord :: (Generic a, GenericParseRecord (Rep a)) => Parser a parseRecord = fmap GHC.Generics.to (genericParseRecord defaultModifiers) -instance ParseFields a => ParseRecord (Only a) +instance ParseFields a => ParseRecord (Only_ a) +instance ParseFields a => ParseRecord (Only a) where + parseRecord = fmap adapt parseRecord + where + adapt (Only_ x) = Only x instance ParseRecord Char where parseRecord = fmap getOnly parseRecord @@ -646,13 +693,54 @@ instance (ParseFields a, ParseFields b) => ParseRecord (Either a b) +{-| Options for customizing derived `ParseRecord` implementations for `Generic` + types + + You can either create the `Modifiers` record directly: + + > modifiers :: Modifiers + > modifiers = Modifiers + > { fieldNameModifier = ... + > , constructorNameModifier = ... + > , shortNameModifier = ... + > } + + ... or you can tweak the `defaultModifiers`: + + > modifiers :: Modifiers + > modifiers = defaultModifiers { fieldNameModifier = ... } + + ... or you can use/tweak a predefined `Modifier`, like `lispCaseModifiers` + + The `parseRecordWithModifiers` function uses this `Modifiers` record when + generating a `Generic` implementation of `ParseRecord` +-} data Modifiers = Modifiers { fieldNameModifier :: String -> String + -- ^ Transform the name of derived fields (Default: @id@) , constructorNameModifier :: String -> String + -- ^ Transform the name of derived constructors (Default: @map toLower@) + , shortNameModifier :: String -> Maybe Char + -- ^ Derives an optional short name from the field name (Default: @\\_ -> Nothing@) } +{-| These are the default modifiers used if you derive a `Generic` + implementation. You can customize this and pass the result to + `parseRecordWithModifiers` if you would like to modify the derived + implementation: + + > myModifiers :: Modifiers + > myModifiers = defaultModifiers { constructorNameModifier = id } + > + > instance ParseRecord MyType where + > parseRecord = parseRecordWithModifiers myModifiers +-} defaultModifiers :: Modifiers -defaultModifiers = Modifiers id (map toLower) +defaultModifiers = Modifiers + { fieldNameModifier = id + , constructorNameModifier = map toLower + , shortNameModifier = \_ -> Nothing + } -- | Convert field and constructor names from @CamelCase@ to @lisp-case@. -- @@ -664,12 +752,19 @@ -- > _type -> --type -- > _splitAt -> --split-at lispCaseModifiers :: Modifiers -lispCaseModifiers = Modifiers lispCase lispCase +lispCaseModifiers = Modifiers lispCase lispCase (\_ -> Nothing) where lispCase = dropWhile (== '-') . (>>= lower) . dropWhile (== '_') lower c | isUpper c = ['-', toLower c] | otherwise = [c] +{-| Use this for the `shortNameModifier` field of the `Modifiers` record if + you want to use the first letter of each option as the short name +-} +firstLetter :: String -> Maybe Char +firstLetter (c:_) = Just c +firstLetter _ = Nothing + class GenericParseRecord f where genericParseRecord :: Modifiers -> Parser (f p) @@ -758,10 +853,11 @@ let m :: M1 i s f a m = undefined - let label = case (selName m) of + let label = case selName m of "" -> Nothing name -> Just (Data.Text.pack (fieldNameModifier name)) - fmap (M1 . K1) (parseFields Nothing label) + let shortName = shortNameModifier (selName m) + fmap (M1 . K1) (parseFields Nothing label shortName) {- [NOTE - Sums] @@ -831,22 +927,73 @@ instance GenericParseRecord f => GenericParseRecord (M1 D c f) where genericParseRecord mods = fmap M1 (Options.helper <*> genericParseRecord mods) -parseRecordWithModifiers :: (Generic a, GenericParseRecord (Rep a)) => Modifiers -> Parser a +{-| Use `parseRecordWithModifiers` when you want to tweak the behavior of a + derived `ParseRecord` implementation, like this: + + > myModifiers :: Modifiers + > myModifiers = defaultModifiers { constructorNameModifier = id } + > + > instance ParseRecord MyType where + > parseRecord = parseRecordWithModifiers myModifiers + + This will still require that you derive `Generic` for your type to automate + most of the implementation, but the `Modifiers` that you pass will change + how the implementation generates the command line interface +-} +parseRecordWithModifiers + :: (Generic a, GenericParseRecord (Rep a)) => Modifiers -> Parser a parseRecordWithModifiers mods = fmap GHC.Generics.to (genericParseRecord mods) -- | Marshal any value that implements `ParseRecord` from the command line +-- +-- If you need to modify the top-level 'ParserInfo' or 'ParserPrefs' +-- use the 'getRecordWith' function. getRecord :: (MonadIO io, ParseRecord a) => Text -- ^ Program description -> io a -getRecord desc = liftIO (Options.customExecParser defaultParserPrefs info) +getRecord desc = getRecordWith header mempty + where + header = Options.header (Data.Text.unpack desc) + +-- | Marshal any value that implements `ParseRecord` from the command line +-- +-- This is the lower-level sibling of 'getRecord and lets you modify +-- the 'ParserInfo' and 'ParserPrefs' records. +getRecordWith + :: (MonadIO io, ParseRecord a) + => Options.InfoMod a + -- ^ 'ParserInfo' modifiers + -> Options.PrefsMod + -- ^ 'ParserPrefs' modifiers + -> io a +getRecordWith infoMods prefsMods = liftIO (Options.customExecParser prefs info) + where + prefs = Options.prefs (defaultParserPrefs <> prefsMods) + info = Options.info parseRecord infoMods + +-- | Marshal any value that implements `ParseRecord` from the commmand line +-- alongside an io action that prints the help message. +getWithHelp + :: (MonadIO io, ParseRecord a) + => Text + -- ^ Program description + -> io (a, io ()) + -- ^ (options, io action to print help message) +getWithHelp desc = do + a <- getRecordWith header mempty + return (a, help) where header = Options.header (Data.Text.unpack desc) - info = Options.info parseRecord header + info = Options.info parseRecord header + help = liftIO (showHelpText (Options.prefs defaultParserPrefs) info) {-| Pure version of `getRecord` +If you need to modify the parser's 'ParserInfo' or 'ParserPrefs', use +`getRecordPureWith`. + >>> :set -XOverloadedStrings >>> getRecordPure ["1"] :: Maybe Int Just 1 @@ -860,17 +1007,41 @@ => [Text] -- ^ Command-line arguments -> Maybe a -getRecordPure args = do +getRecordPure args = getRecordPureWith args mempty mempty + +{-| Pure version of `getRecordWith` + +Like `getRecordWith`, this is a sibling of 'getRecordPure and +exposes the monoidal modifier structures for 'ParserInfo' and +'ParserPrefs' to you. + +>>> :set -XOverloadedStrings +>>> getRecordPureWith ["1"] mempty mempty :: Maybe Int +Just 1 +>>> getRecordPureWith ["1", "2"] mempty mempty :: Maybe [Int] +Just [1,2] +>>> getRecordPureWith ["Foo"] mempty mempty :: Maybe Int +Nothing +-} +getRecordPureWith + :: ParseRecord a + => [Text] + -- ^ Command-line arguments + -> Options.InfoMod a + -- ^ 'ParserInfo' modifiers + -> Options.PrefsMod + -- ^ 'ParserPrefs' modifiers + -> Maybe a +getRecordPureWith args infoMod prefsMod = do let header = Options.header "" - let info = Options.info parseRecord header + let info = Options.info parseRecord (header <> infoMod) + let prefs = Options.prefs (defaultParserPrefs <> prefsMod) let args' = map Data.Text.unpack args - Options.getParseResult (Options.execParserPure defaultParserPrefs info args') + Options.getParseResult (Options.execParserPure prefs info args') -- | @optparse-generic@'s flavor of options. -defaultParserPrefs :: Options.ParserPrefs -defaultParserPrefs = Options.defaultPrefs - { Options.prefMultiSuffix = "..." - } +defaultParserPrefs :: Options.PrefsMod +defaultParserPrefs = Options.multiSuffix "..." -- | A type family to extract fields wrapped using '(<?>)' type family (:::) wrap wrapped @@ -929,3 +1100,20 @@ -- ^ Command-line arguments -> Maybe (f Unwrapped) unwrapRecordPure = fmap unwrap . getRecordPure + +showHelpText :: Options.ParserPrefs -> Options.ParserInfo a -> IO () +showHelpText pprefs pinfo = + Options.handleParseResult . Options.Failure $ + Options.parserFailure pprefs pinfo Options.ShowHelpText mempty + +-- | Marshal any value that implements 'ParseRecord' from the command line +-- and unwrap its fields alongside an io action to print the help message +unwrapWithHelp + :: (MonadIO io, ParseRecord (f Wrapped), Unwrappable f) + => Text + -- ^ Program description + -> io (f Unwrapped, io ()) + -- ^ (options, io action to print help message) +unwrapWithHelp desc = do + (opts, help) <- getWithHelp desc + return (unwrap opts, help)

1 0

commit ghc-opml-conduit for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-opml-conduit for openSUSE:Factory checked in at 2017-08-31 20:57:40 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-opml-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-opml-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-opml-conduit" Thu Aug 31 20:57:40 2017 rev:2 rq:513443 version:0.6.0.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-opml-conduit/ghc-opml-conduit.changes 2017-05-17 10:50:05.310832266 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-opml-conduit.new/ghc-opml-conduit.changes 2017-08-31 20:57:41.713032884 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:34 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.0.3. + +------------------------------------------------------------------- Old: ---- opml-conduit-0.6.0.1.tar.gz New: ---- opml-conduit-0.6.0.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-opml-conduit.spec ++++++ --- /var/tmp/diff_new_pack.AJUDDT/_old 2017-08-31 20:57:42.400936231 +0200 +++ /var/tmp/diff_new_pack.AJUDDT/_new 2017-08-31 20:57:42.404935669 +0200 @@ -19,7 +19,7 @@ %global pkg_name opml-conduit %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.6.0.1 +Version: 0.6.0.3 Release: 0 Summary: Streaming parser/renderer for the OPML 2.0 format License: WTFPL ++++++ opml-conduit-0.6.0.1.tar.gz -> opml-conduit-0.6.0.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/opml-conduit-0.6.0.1/Text/OPML/Conduit/Parse.hs new/opml-conduit-0.6.0.3/Text/OPML/Conduit/Parse.hs --- old/opml-conduit-0.6.0.1/Text/OPML/Conduit/Parse.hs 2016-10-04 22:30:49.000000000 +0200 +++ new/opml-conduit-0.6.0.3/Text/OPML/Conduit/Parse.hs 2017-06-14 23:10:08.000000000 +0200 @@ -21,7 +21,7 @@ -- {{{ Imports import Conduit hiding (throwM) -import Control.Applicative hiding(many) +import Control.Applicative hiding (many) import Control.Exception.Safe as Exception import Control.Monad import Control.Monad.Fix @@ -106,19 +106,19 @@ asCategories :: Text -> [NonEmpty (NonNull Text)] asCategories = mapMaybe (nonEmpty . mapMaybe fromNullable . split (== '/')) . split (== ',') -dateTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe UTCTime) +dateTag :: (MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe UTCTime) dateTag name = tagIgnoreAttrs name $ content >>= asTime -uriTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe URI) +uriTag :: (MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe URI) uriTag name = tagIgnoreAttrs name $ content >>= asURI expansionStateTag :: (MonadThrow m, Integral a) => ConduitM Event o m (Maybe [a]) expansionStateTag = tagIgnoreAttrs "expansionState" $ content >>= asExpansionState -textTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe Text) +textTag :: (MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe Text) textTag name = tagIgnoreAttrs name content -decimalTag :: (Integral a, MonadThrow m) => Name -> ConduitM Event o m (Maybe a) +decimalTag :: (Integral i, MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe i) decimalTag name = tagIgnoreAttrs name $ content >>= asDecimal projectC :: Monad m => Fold a a' b b' -> Conduit a m b @@ -153,7 +153,7 @@ -- - each sub-element may be repeated, in which case only the first occurrence is taken into account; -- - each unknown sub-element is ignored. parseOpmlHead :: (MonadCatch m) => ConduitM Event o m (Maybe OpmlHead) -parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAllTreesContent) =$= zipConduit where +parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAnyTreeContent) =$= zipConduit where zipConduit = getZipConduit $ OpmlHead <$> ZipConduit (projectC _HeadTitle =$= headDefC mempty) <*> ZipConduit (projectC _HeadCreated =$= headC) @@ -187,7 +187,7 @@ -- | Parse an @\<outline\>@ section. -- The value of type attributes are not case-sensitive, that is @type=\"LINK\"@ has the same meaning as @type="link"@. parseOpmlOutline :: (MonadCatch m) => ConduitM Event o m (Maybe (Tree OpmlOutline)) -parseOpmlOutline = tagName "outline" attributes handler where +parseOpmlOutline = tag' "outline" attributes handler where attributes = do otype <- optional $ requireAttr "type" case mk <$> otype of @@ -222,9 +222,9 @@ -- | Parse the top-level @\<opml\>@ element. parseOpml :: (MonadCatch m) => ConduitM Event o m (Maybe Opml) -parseOpml = tagName "opml" attributes handler where +parseOpml = tag' "opml" attributes handler where attributes = (requireAttr "version" >>= asVersion) <* ignoreAttrs - handler version = (manyYield' (choose piece) <* many ignoreAllTreesContent) =$= zipConduit version + handler version = (manyYield' (choose piece) <* many ignoreAnyTreeContent) =$= zipConduit version zipConduit version = getZipConduit $ Opml version <$> ZipConduit (projectC _DocHead =$= headDefC mkOpmlHead) <*> ZipConduit (projectC _DocBody =$= headDefC mempty) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/opml-conduit-0.6.0.1/Text/OPML/Lens.hs new/opml-conduit-0.6.0.3/Text/OPML/Lens.hs --- old/opml-conduit-0.6.0.1/Text/OPML/Lens.hs 2016-10-04 22:30:49.000000000 +0200 +++ new/opml-conduit-0.6.0.3/Text/OPML/Lens.hs 2017-06-14 23:10:08.000000000 +0200 @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Text.OPML.Lens where +module Text.OPML.Lens (module Text.OPML.Lens) where -- {{{ Imports import Lens.Simple @@ -34,7 +34,7 @@ ] ''OpmlHead expansionStateL :: Traversal' OpmlHead Int -expansionStateL inj a@OpmlHead { expansionState = es } = (\x -> a { expansionState = x }) <$> sequenceA (map inj es) +expansionStateL inj a@OpmlHead { expansionState = es } = (\x -> a { expansionState = x }) <$> traverse inj es {-# INLINE expansionStateL #-} -- * 'OutlineSubscription' lenses diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/opml-conduit-0.6.0.1/Text/OPML/Types.hs new/opml-conduit-0.6.0.3/Text/OPML/Types.hs --- old/opml-conduit-0.6.0.1/Text/OPML/Types.hs 2016-08-19 08:24:54.000000000 +0200 +++ new/opml-conduit-0.6.0.3/Text/OPML/Types.hs 2017-06-14 23:10:08.000000000 +0200 @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} -- | OPML is an XML format for outlines. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/opml-conduit-0.6.0.1/opml-conduit.cabal new/opml-conduit-0.6.0.3/opml-conduit.cabal --- old/opml-conduit-0.6.0.1/opml-conduit.cabal 2016-10-04 22:56:00.000000000 +0200 +++ new/opml-conduit-0.6.0.3/opml-conduit.cabal 2017-06-14 23:10:08.000000000 +0200 @@ -1,5 +1,5 @@ name: opml-conduit -version: 0.6.0.1 +version: 0.6.0.3 synopsis: Streaming parser/renderer for the OPML 2.0 format. description: This library implements the OPML 2.0 standard (<http://dev.opml.org/spec2.html>) as a 'conduit' parser/renderer. @@ -45,7 +45,7 @@ , time >= 1.5 , timerep >= 2.0.0 , uri-bytestring >= 0.2 - , xml-conduit >= 1.3 + , xml-conduit >= 1.5 , xml-types default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/opml-conduit-0.6.0.1/test/Arbitrary.hs new/opml-conduit-0.6.0.3/test/Arbitrary.hs --- old/opml-conduit-0.6.0.1/test/Arbitrary.hs 2016-10-04 22:32:29.000000000 +0200 +++ new/opml-conduit-0.6.0.3/test/Arbitrary.hs 2017-06-14 23:10:08.000000000 +0200 @@ -7,7 +7,7 @@ {-# LANGUAGE StandaloneDeriving #-} -- | External 'Arbitrary' instances used by OPML types. -- All instances are defined through the 'OpmlGen' wrapper to avoid conflicts. -module Arbitrary where +module Arbitrary (module Arbitrary) where -- {{{ Imports import Data.ByteString (ByteString)

1 0

commit ghc-octane for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-octane for openSUSE:Factory checked in at 2017-08-31 20:57:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-octane (Old) and /work/SRC/openSUSE:Factory/.ghc-octane.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-octane" Thu Aug 31 20:57:35 2017 rev:2 rq:513442 version:0.20.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-octane/ghc-octane.changes 2017-05-09 18:15:20.853472721 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-octane.new/ghc-octane.changes 2017-08-31 20:57:40.085261591 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:14 UTC 2017 - psimons(a)suse.com + +- Update to version 0.20.0. + +------------------------------------------------------------------- Old: ---- octane-0.18.3.tar.gz New: ---- octane-0.20.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-octane.spec ++++++ --- /var/tmp/diff_new_pack.BgUsQ5/_old 2017-08-31 20:57:41.121116049 +0200 +++ /var/tmp/diff_new_pack.BgUsQ5/_new 2017-08-31 20:57:41.125115488 +0200 @@ -18,7 +18,7 @@ %global pkg_name octane Name: ghc-%{pkg_name} -Version: 0.18.3 +Version: 0.20.0 Release: 0 Summary: Parse Rocket League replays License: MIT ++++++ octane-0.18.3.tar.gz -> octane-0.20.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/README.markdown new/octane-0.20.0/README.markdown --- old/octane-0.18.3/README.markdown 2017-04-17 15:39:47.000000000 +0200 +++ new/octane-0.20.0/README.markdown 2017-07-11 16:49:36.000000000 +0200 @@ -8,7 +8,9 @@ Replays][] parses tens of thousands of replays with it. Octane parses most replays in less than 5 seconds. It outputs easy-to-read JSON. -If you also want to generate replays, consider using [Rattletrap][] instead. +That being said, Octane is not actively developed anymore. Consider using +[Rattletrap][] (which is actively developed) instead. Rattletrap can also +generate replay files from JSON, which Octane cannot do. Octane has a command-line interface. To get it, download and unpack [the latest release][] for your platform. You can run the executable one of three ways: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/library/Octane/Type/Replay.hs new/octane-0.20.0/library/Octane/Type/Replay.hs --- old/octane-0.18.3/library/Octane/Type/Replay.hs 2017-04-17 15:39:47.000000000 +0200 +++ new/octane-0.20.0/library/Octane/Type/Replay.hs 2017-07-11 16:49:36.000000000 +0200 @@ -309,6 +309,13 @@ StrictText.pack value = case Rattletrap.attributeValue attribute of + Rattletrap.AppliedDamageAttributeValue x -> + Value.ValueAppliedDamage + (Value.AppliedDamageValue + (toWord8 (Rattletrap.appliedDamageAttributeUnknown1 x)) + (toIntVector (Rattletrap.appliedDamageAttributeLocation x)) + (toInt32 (Rattletrap.appliedDamageAttributeUnknown3 x)) + (toInt32 (Rattletrap.appliedDamageAttributeUnknown4 x))) Rattletrap.BooleanAttributeValue x -> Value.ValueBoolean (Value.BooleanValue @@ -334,6 +341,15 @@ (toWord8 (Rattletrap.clubColorsAttributeBlueColor x)) (Boolean.Boolean (Rattletrap.clubColorsAttributeOrangeFlag x)) (toWord8 (Rattletrap.clubColorsAttributeOrangeColor x))) + Rattletrap.DamageStateAttributeValue x -> + Value.ValueDamageState + (Value.DamageStateValue + (toWord8 (Rattletrap.damageStateAttributeUnknown1 x)) + (Boolean.Boolean (Rattletrap.damageStateAttributeUnknown2 x)) + (toInt32 (Rattletrap.damageStateAttributeUnknown3 x)) + (toIntVector (Rattletrap.damageStateAttributeUnknown4 x)) + (Boolean.Boolean (Rattletrap.damageStateAttributeUnknown5 x)) + (Boolean.Boolean (Rattletrap.damageStateAttributeUnknown6 x))) Rattletrap.DemolishAttributeValue x -> Value.ValueDemolish (Value.DemolishValue @@ -354,6 +370,14 @@ (Boolean.Boolean False) (Just (toInt32 (Rattletrap.explosionAttributeActorId x))) (toIntVector (Rattletrap.explosionAttributeLocation x))) + Rattletrap.ExtendedExplosionAttributeValue x -> + Value.ValueExtendedExplosion + (Value.ExtendedExplosionValue + (Boolean.Boolean False) + (Just (toInt32 (Rattletrap.extendedExplosionAttributeActorId x))) + (toIntVector (Rattletrap.extendedExplosionAttributeLocation x)) + (Boolean.Boolean (Rattletrap.extendedExplosionAttributeUnknown1 x)) + (toInt32 (Rattletrap.extendedExplosionAttributeUnknown2 x))) Rattletrap.FlaggedIntAttributeValue x -> Value.ValueFlaggedInt (Value.FlaggedIntValue diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/library/Octane/Type/Value/AppliedDamageValue.hs new/octane-0.20.0/library/Octane/Type/Value/AppliedDamageValue.hs --- old/octane-0.18.3/library/Octane/Type/Value/AppliedDamageValue.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/octane-0.20.0/library/Octane/Type/Value/AppliedDamageValue.hs 2017-07-11 16:49:36.000000000 +0200 @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.AppliedDamageValue + ( AppliedDamageValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Vector as Vector +import qualified Octane.Type.Word8 as Word8 + +data AppliedDamageValue = AppliedDamageValue + { appliedDamageValueUnknown1 :: Word8.Word8 + , appliedDamageValueLocation :: Vector.Vector Int + , appliedDamageValueUnknown3 :: Int32.Int32 + , appliedDamageValueUnknown4 :: Int32.Int32 + } deriving (Eq, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''AppliedDamageValue) + +instance Aeson.ToJSON AppliedDamageValue where + toJSON x = + Aeson.object + [ "Type" .= ("AppliedDamage" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "unknown1" .= appliedDamageValueUnknown1 x + , "location" .= appliedDamageValueLocation x + , "unknown3" .= appliedDamageValueUnknown3 x + , "unknown4" .= appliedDamageValueUnknown4 x + ] + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/library/Octane/Type/Value/DamageStateValue.hs new/octane-0.20.0/library/Octane/Type/Value/DamageStateValue.hs --- old/octane-0.18.3/library/Octane/Type/Value/DamageStateValue.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/octane-0.20.0/library/Octane/Type/Value/DamageStateValue.hs 2017-07-11 16:49:36.000000000 +0200 @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.DamageStateValue + ( DamageStateValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Vector as Vector +import qualified Octane.Type.Word8 as Word8 + +data DamageStateValue = DamageStateValue + { damageStateValueUnknown1 :: Word8.Word8 + , damageStateValueUnknown2 :: Boolean.Boolean + , damageStateValueUnknown3 :: Int32.Int32 + , damageStateValueUnknown4 :: Vector.Vector Int + , damageStateValueUnknown5 :: Boolean.Boolean + , damageStateValueUnknown6 :: Boolean.Boolean + } deriving (Eq, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''DamageStateValue) + +instance Aeson.ToJSON DamageStateValue where + toJSON x = + Aeson.object + [ "Type" .= ("DamageState" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "unknown1" .= damageStateValueUnknown1 x + , "unknown2" .= damageStateValueUnknown2 x + , "unknown3" .= damageStateValueUnknown3 x + , "unknown4" .= damageStateValueUnknown4 x + , "unknown5" .= damageStateValueUnknown5 x + , "unknown6" .= damageStateValueUnknown6 x + ] + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/library/Octane/Type/Value/ExtendedExplosionValue.hs new/octane-0.20.0/library/Octane/Type/Value/ExtendedExplosionValue.hs --- old/octane-0.18.3/library/Octane/Type/Value/ExtendedExplosionValue.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/octane-0.20.0/library/Octane/Type/Value/ExtendedExplosionValue.hs 2017-07-11 16:49:36.000000000 +0200 @@ -0,0 +1,45 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.ExtendedExplosionValue + ( ExtendedExplosionValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Vector as Vector + +data ExtendedExplosionValue = ExtendedExplosionValue + { extendedExplosionValueActorless :: Boolean.Boolean + , extendedExplosionValueActorId :: Maybe Int32.Int32 + , extendedExplosionValuePosition :: Vector.Vector Int + , extendedExplosionValueUnknown1 :: Boolean.Boolean + , extendedExplosionValueUnknown2 :: Int32.Int32 + } deriving (Eq, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ExtendedExplosionValue) + +instance Aeson.ToJSON ExtendedExplosionValue where + toJSON x = + Aeson.object + [ "Type" .= ("ExtendedExplosion" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Actorless" .= #actorless x + , "ActorId" .= #actorId x + , "Position" .= #position x + ] + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/library/Octane/Type/Value.hs new/octane-0.20.0/library/Octane/Type/Value.hs --- old/octane-0.18.3/library/Octane/Type/Value.hs 2017-04-17 15:39:47.000000000 +0200 +++ new/octane-0.20.0/library/Octane/Type/Value.hs 2017-07-11 16:49:36.000000000 +0200 @@ -2,13 +2,16 @@ module Octane.Type.Value ( Value(..) + , module Octane.Type.Value.AppliedDamageValue , module Octane.Type.Value.BooleanValue , module Octane.Type.Value.ByteValue , module Octane.Type.Value.CamSettingsValue , module Octane.Type.Value.ClubColorsValue + , module Octane.Type.Value.DamageStateValue , module Octane.Type.Value.DemolishValue , module Octane.Type.Value.EnumValue , module Octane.Type.Value.ExplosionValue + , module Octane.Type.Value.ExtendedExplosionValue , module Octane.Type.Value.FlaggedIntValue , module Octane.Type.Value.FloatValue , module Octane.Type.Value.GameModeValue @@ -30,13 +33,16 @@ , module Octane.Type.Value.WeldedInfoValue ) where +import Octane.Type.Value.AppliedDamageValue import Octane.Type.Value.BooleanValue import Octane.Type.Value.ByteValue import Octane.Type.Value.CamSettingsValue import Octane.Type.Value.ClubColorsValue +import Octane.Type.Value.DamageStateValue import Octane.Type.Value.DemolishValue import Octane.Type.Value.EnumValue import Octane.Type.Value.ExplosionValue +import Octane.Type.Value.ExtendedExplosionValue import Octane.Type.Value.FlaggedIntValue import Octane.Type.Value.FloatValue import Octane.Type.Value.GameModeValue @@ -61,13 +67,16 @@ -- | A replicated property's value. data Value - = ValueBoolean BooleanValue + = ValueAppliedDamage AppliedDamageValue + | ValueBoolean BooleanValue | ValueByte ByteValue | ValueCamSettings CamSettingsValue | ValueClubColors ClubColorsValue + | ValueDamageState DamageStateValue | ValueDemolish DemolishValue | ValueEnum EnumValue | ValueExplosion ExplosionValue + | ValueExtendedExplosion ExtendedExplosionValue | ValueFlaggedInt FlaggedIntValue | ValueFloat FloatValue | ValueGameMode GameModeValue @@ -92,13 +101,16 @@ instance Aeson.ToJSON Value where toJSON value = case value of + ValueAppliedDamage x -> Aeson.toJSON x ValueBoolean x -> Aeson.toJSON x ValueByte x -> Aeson.toJSON x ValueCamSettings x -> Aeson.toJSON x ValueClubColors x -> Aeson.toJSON x + ValueDamageState x -> Aeson.toJSON x ValueDemolish x -> Aeson.toJSON x ValueEnum x -> Aeson.toJSON x ValueExplosion x -> Aeson.toJSON x + ValueExtendedExplosion x -> Aeson.toJSON x ValueFlaggedInt x -> Aeson.toJSON x ValueFloat x -> Aeson.toJSON x ValueGameMode x -> Aeson.toJSON x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/octane.cabal new/octane-0.20.0/octane.cabal --- old/octane-0.18.3/octane.cabal 2017-04-17 15:42:20.000000000 +0200 +++ new/octane-0.20.0/octane.cabal 2017-07-11 16:52:01.000000000 +0200 @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: octane -version: 0.18.3 +version: 0.20.0 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game @@ -75,13 +75,16 @@ Octane.Type.State Octane.Type.Text Octane.Type.Value + Octane.Type.Value.AppliedDamageValue Octane.Type.Value.BooleanValue Octane.Type.Value.ByteValue Octane.Type.Value.CamSettingsValue Octane.Type.Value.ClubColorsValue + Octane.Type.Value.DamageStateValue Octane.Type.Value.DemolishValue Octane.Type.Value.EnumValue Octane.Type.Value.ExplosionValue + Octane.Type.Value.ExtendedExplosionValue Octane.Type.Value.FlaggedIntValue Octane.Type.Value.FloatValue Octane.Type.Value.GameModeValue diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/package.yaml new/octane-0.20.0/package.yaml --- old/octane-0.18.3/package.yaml 2017-04-17 15:39:47.000000000 +0200 +++ new/octane-0.20.0/package.yaml 2017-07-11 16:49:36.000000000 +0200 @@ -44,4 +44,4 @@ maintainer: Taylor Fausak name: octane synopsis: Parse Rocket League replays. -version: '0.18.3' +version: '0.20.0' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/octane-0.18.3/stack.yaml new/octane-0.20.0/stack.yaml --- old/octane-0.18.3/stack.yaml 2017-04-17 15:39:47.000000000 +0200 +++ new/octane-0.20.0/stack.yaml 2017-07-11 16:49:36.000000000 +0200 @@ -1 +1,3 @@ +extra-deps: +- rattletrap-2.5.0 resolver: lts-8.0

1 0

commit ghc-nfc for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-nfc for openSUSE:Factory checked in at 2017-08-31 20:57:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-nfc (Old) and /work/SRC/openSUSE:Factory/.ghc-nfc.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-nfc" Thu Aug 31 20:57:32 2017 rev:2 rq:513440 version:0.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-nfc/ghc-nfc.changes 2017-04-12 18:08:04.491029521 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-nfc.new/ghc-nfc.changes 2017-08-31 20:57:33.454193276 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:43 UTC 2017 - psimons(a)suse.com + +- Update to version 0.1.0. + +------------------------------------------------------------------- Old: ---- nfc-0.0.1.tar.gz New: ---- nfc-0.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-nfc.spec ++++++ --- /var/tmp/diff_new_pack.bZ2TXO/_old 2017-08-31 20:57:34.298074709 +0200 +++ /var/tmp/diff_new_pack.bZ2TXO/_new 2017-08-31 20:57:34.310073022 +0200 @@ -18,7 +18,7 @@ %global pkg_name nfc Name: ghc-%{pkg_name} -Version: 0.0.1 +Version: 0.1.0 Release: 0 Summary: Libnfc bindings License: SUSE-Public-Domain ++++++ nfc-0.0.1.tar.gz -> nfc-0.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/CHANGELOG.md new/nfc-0.1.0/CHANGELOG.md --- old/nfc-0.0.1/CHANGELOG.md 2016-12-09 08:24:58.000000000 +0100 +++ new/nfc-0.1.0/CHANGELOG.md 2016-12-20 19:00:25.000000000 +0100 @@ -1,3 +1,3 @@ -# 0.0.0 +# 0.0.1 * Initial release diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/cbits/NFC.c new/nfc-0.1.0/cbits/NFC.c --- old/nfc-0.0.1/cbits/NFC.c 1970-01-01 01:00:00.000000000 +0100 +++ new/nfc-0.1.0/cbits/NFC.c 2017-02-22 18:33:33.000000000 +0100 @@ -0,0 +1,33 @@ +#include "nfc/nfc.h" +#include "nfc/nfc-types.h" + +/* These functions are needed because the libnfc author used #pragma pack(1). + * c2hs does not recognize this compiler directive. + */ +nfc_modulation *hs_nfc_get_nm(nfc_target *t) { return &t->nm; } + +size_t hs_nfc_target_size() { return sizeof(nfc_target); } + +uint8_t *hs_nfc_get_nai_abtAtqa(nfc_target *t) { return t->nti.nai.abtAtqa; } +uint8_t hs_nfc_get_nai_btSak(nfc_target *t) { return t->nti.nai.btSak; } +size_t hs_nfc_get_nai_szUidLen(nfc_target *t) { return t->nti.nai.szUidLen; } +uint8_t *hs_nfc_get_nai_abtUid(nfc_target *t) { return t->nti.nai.abtUid; } +size_t hs_nfc_get_nai_szAtsLen(nfc_target *t) { return t->nti.nai.szAtsLen; } +uint8_t *hs_nfc_get_nai_abtAts(nfc_target *t) { return t->nti.nai.abtAts; } + +/* Normally I would have c2hs make this for me, but I need to return Nothing or + * Just NFCTarget based on the return value, which c2hs does not support at this + * time. + */ +int __wrapped__nfc_initiator_select_passive_target (nfc_device *pnd, + const nfc_modulation *nm, + const uint8_t *pbtInitData, + const size_t szInitData, + nfc_target *pnt) +{ + return nfc_initiator_select_passive_target (pnd, + *nm, + pbtInitData, + szInitData, + pnt); +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/examples/print-mifare-uid-forever.hs new/nfc-0.1.0/examples/print-mifare-uid-forever.hs --- old/nfc-0.0.1/examples/print-mifare-uid-forever.hs 2016-12-14 19:34:18.000000000 +0100 +++ new/nfc-0.1.0/examples/print-mifare-uid-forever.hs 2017-02-22 18:32:27.000000000 +0100 @@ -16,6 +16,9 @@ Just d -> do void $ initiatorInit d forever $ do - let nfcMod = NFCModulation NmtIso14443a Nbr106 - (_, NFCTargetISO14443a info) <- initiatorSelectPassiveTarget d nfcMod Nothing - C8.putStrLn $ encode $ iso14443aAbtUid info + let nfcMod = NFCModulation NmtIso14443a Nbr106 + maybeTarget <- initiatorSelectPassiveTarget d nfcMod Nothing + -- OR: maybeTarget <- initiatorPollTarget d [nfcMod] 7 5 + case maybeTarget of + Just (NFCTargetISO14443a info) -> C8.putStrLn . encode $ iso14443aAbtUid info + _ -> return () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/nfc.cabal new/nfc-0.1.0/nfc.cabal --- old/nfc-0.0.1/nfc.cabal 2016-12-20 18:58:27.000000000 +0100 +++ new/nfc-0.1.0/nfc.cabal 2017-02-22 19:23:23.000000000 +0100 @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: nfc -version: 0.0.1 +version: 0.1.0 synopsis: libnfc bindings description: nfc is a set of bindings to libnfc category: Bindings @@ -33,6 +33,8 @@ hs-source-dirs: src ghc-options: -Wall + c-sources: + cbits/NFC.c extra-libraries: nfc build-depends: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/package.yaml new/nfc-0.1.0/package.yaml --- old/nfc-0.0.1/package.yaml 2016-12-20 18:58:25.000000000 +0100 +++ new/nfc-0.1.0/package.yaml 2017-02-22 19:23:05.000000000 +0100 @@ -1,6 +1,6 @@ name: nfc synopsis: libnfc bindings -version: '0.0.1' +version: '0.1.0' license: PublicDomain maintainer: John Galt <jgalt(a)centromere.net> category: Bindings @@ -29,6 +29,7 @@ - Bindings.NFC extra-libraries: - nfc + c-sources: cbits/* executables: print-mifare-uid-forever: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/src/Bindings/NFC.chs new/nfc-0.1.0/src/Bindings/NFC.chs --- old/nfc-0.0.1/src/Bindings/NFC.chs 2016-12-20 18:53:22.000000000 +0100 +++ new/nfc-0.1.0/src/Bindings/NFC.chs 2017-02-22 18:32:08.000000000 +0100 @@ -13,12 +13,12 @@ , initiatorPollTarget ) where -import Control.Monad ((>=>)) +import Control.Monad ((<=<)) import Data.ByteString (ByteString, packCStringLen) import Data.Word (Word8, Word16) import Foreign.C.String (withCStringLen) import Foreign.C.Types (CUChar(..)) -import Foreign.ForeignPtr (newForeignPtr) +import Foreign.ForeignPtr (newForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (allocaArray, pokeArray) @@ -41,7 +41,7 @@ data NFCTarget = NFCTargetISO14443a NFCISO14443aInfo outNfcCtx :: Ptr (Ptr ()) -> IO NFCContextPtr -outNfcCtx = peek >=> newForeignPtr nfc_exit +outNfcCtx = newForeignPtr nfc_exit <=< peek outNfcDev :: Ptr () -> IO (Maybe NFCDevicePtr) outNfcDev = maybePeek $ newForeignPtr nfc_close @@ -50,8 +50,8 @@ inMaybeStrLen Nothing f = f (nullPtr, 0) inMaybeStrLen (Just str) f = withCStringLen str $ \(ptr, len) -> f (castPtr ptr, fromIntegral len) -inNFCMod :: Num a => [NFCModulation] -> ((Ptr NFCModulation, a) -> IO b) -> IO b -inNFCMod nfcMod f = do +inNfcMod :: Num a => [NFCModulation] -> ((Ptr NFCModulation, a) -> IO b) -> IO b +inNfcMod nfcMod f = do let len = length nfcMod allocaArray len $ \ptr -> do @@ -61,6 +61,24 @@ #include "nfc/nfc.h" #include "nfc/nfc-types.h" +#c + +nfc_modulation *hs_nfc_get_nm(nfc_target *t); +size_t hs_nfc_target_size(); +uint8_t *hs_nfc_get_nai_abtAtqa(nfc_target *t); +uint8_t hs_nfc_get_nai_btSak(nfc_target *t); +size_t hs_nfc_get_nai_szUidLen(nfc_target *t); +uint8_t *hs_nfc_get_nai_abtUid(nfc_target *t); +size_t hs_nfc_get_nai_szAtsLen(nfc_target *t); +uint8_t *hs_nfc_get_nai_abtAts(nfc_target *t); +int __wrapped__nfc_initiator_select_passive_target (nfc_device *, + const nfc_modulation *, + const uint8_t *, + const size_t, + nfc_target *); + +#endc + {#enum nfc_modulation_type as NFCModulationType {underscoreToCase} deriving (Eq,Show)#} {#enum nfc_baud_rate as NFCBaudRate {underscoreToCase} deriving (Eq, Show)#} @@ -79,29 +97,39 @@ {#fun nfc_initiator_init as initiatorInit {`NFCDevicePtr'} -> `Int'#} -{#fun nfc_initiator_select_passive_target as initiatorSelectPassiveTarget -{`NFCDevicePtr', with* %`NFCModulation', inMaybeStrLen* `Maybe String'&, alloca- `NFCTarget' peek*} -> `Int'#} - -{#fun nfc_initiator_poll_target as initiatorPollTarget -{`NFCDevicePtr', inNFCMod* `[NFCModulation]'&, `Word8', `Word8', alloca- `NFCTarget' peek*} -> `Int'#} - -#c - -/* These functions are needed because the libnfc author used #pragma pack(1). - * c2hs does not recognize this compiler directive. - */ -nfc_modulation *hs_nfc_get_nm(nfc_target *t) { return &t->nm; } - -size_t hs_nfc_target_size() { return sizeof(nfc_target); } - -uint8_t *hs_nfc_get_nai_abtAtqa(nfc_target *t) { return t->nti.nai.abtAtqa; } -uint8_t hs_nfc_get_nai_btSak(nfc_target *t) { return t->nti.nai.btSak; } -size_t hs_nfc_get_nai_szUidLen(nfc_target *t) { return t->nti.nai.szUidLen; } -uint8_t *hs_nfc_get_nai_abtUid(nfc_target *t) { return t->nti.nai.abtUid; } -size_t hs_nfc_get_nai_szAtsLen(nfc_target *t) { return t->nti.nai.szAtsLen; } -uint8_t *hs_nfc_get_nai_abtAts(nfc_target *t) { return t->nti.nai.abtAts; } - -#endc +initiatorSelectPassiveTarget :: NFCDevicePtr -> NFCModulation -> Maybe String -> IO (Maybe NFCTarget) +initiatorSelectPassiveTarget dev nfcMod initData = + withForeignPtr dev $ \devPtr -> + with nfcMod $ \nfcModPtr -> + inMaybeStrLen initData $ \(strPtr, strLen) -> + alloca $ \target -> do + returnValue <- {#call __wrapped__nfc_initiator_select_passive_target#} + devPtr + nfcModPtr + strPtr + strLen + target + + if returnValue /= 1 + then return Nothing + else (return . Just <=< peek) target + +initiatorPollTarget :: NFCDevicePtr -> [NFCModulation] -> Word8 -> Word8 -> IO (Maybe NFCTarget) +initiatorPollTarget dev nfcMod numPolling period = do + withForeignPtr dev $ \devPtr -> + inNfcMod nfcMod $ \(nfcModArray, nfcModLen) -> + alloca $ \target -> do + returnValue <- {#call nfc_initiator_poll_target#} + devPtr + nfcModArray + nfcModLen + (fromIntegral numPolling) + (fromIntegral period) + target + + if returnValue /= 1 + then return Nothing + else (return . Just <=< peek) target decodeIso14443a :: Ptr NFCTarget -> IO NFCTarget decodeIso14443a p = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/nfc-0.0.1/stack.yaml new/nfc-0.1.0/stack.yaml --- old/nfc-0.0.1/stack.yaml 2016-12-20 18:55:14.000000000 +0100 +++ new/nfc-0.1.0/stack.yaml 2017-02-21 09:26:42.000000000 +0100 @@ -1,4 +1,4 @@ -resolver: lts-7.14 +resolver: lts-8.2 packages: - '.' extra-deps: []

1 0

commit ghc-network-carbon for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-network-carbon for openSUSE:Factory checked in at 2017-08-31 20:57:30 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-network-carbon (Old) and /work/SRC/openSUSE:Factory/.ghc-network-carbon.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-network-carbon" Thu Aug 31 20:57:30 2017 rev:2 rq:513439 version:1.0.10 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-network-carbon/ghc-network-carbon.changes 2017-04-12 18:07:58.667852897 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-network-carbon.new/ghc-network-carbon.changes 2017-08-31 20:57:31.330491663 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:58 UTC 2017 - psimons(a)suse.com + +- Update to version 1.0.10. + +------------------------------------------------------------------- Old: ---- network-carbon-1.0.9.tar.gz New: ---- network-carbon-1.0.10.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-network-carbon.spec ++++++ --- /var/tmp/diff_new_pack.RU1IU8/_old 2017-08-31 20:57:32.330351180 +0200 +++ /var/tmp/diff_new_pack.RU1IU8/_new 2017-08-31 20:57:32.338350056 +0200 @@ -18,7 +18,7 @@ %global pkg_name network-carbon Name: ghc-%{pkg_name} -Version: 1.0.9 +Version: 1.0.10 Release: 0 Summary: A Haskell implementation of the Carbon protocol (part of the Graphite monitoring tools) License: BSD-3-Clause ++++++ network-carbon-1.0.9.tar.gz -> network-carbon-1.0.10.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/network-carbon-1.0.9/Changelog.md new/network-carbon-1.0.10/Changelog.md --- old/network-carbon-1.0.9/Changelog.md 2017-02-18 10:49:49.000000000 +0100 +++ new/network-carbon-1.0.10/Changelog.md 2017-07-24 14:28:04.000000000 +0200 @@ -1,3 +1,11 @@ +## 1.0.10 + +### Other Changes + +* Increased the upper bound of `base`. + +--- + ## 1.0.9 ### Other Changes diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/network-carbon-1.0.9/network-carbon.cabal new/network-carbon-1.0.10/network-carbon.cabal --- old/network-carbon-1.0.9/network-carbon.cabal 2017-02-18 10:49:49.000000000 +0100 +++ new/network-carbon-1.0.10/network-carbon.cabal 2017-07-24 14:28:04.000000000 +0200 @@ -1,5 +1,5 @@ name: network-carbon -version: 1.0.9 +version: 1.0.10 synopsis: A Haskell implementation of the Carbon protocol (part of the Graphite monitoring tools) homepage: http://github.com/ocharles/network-carbon license: BSD3 @@ -15,7 +15,7 @@ Network.Carbon.Plaintext build-depends: - base >=4.6 && <4.10, + base >=4.6 && <4.11, bytestring >=0.10.2 && <0.11, network >= 2.4 && < 2.7, text >= 0.10 && < 1.3,

1 0

commit ghc-names-th for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-names-th for openSUSE:Factory checked in at 2017-08-31 20:57:27 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-names-th (Old) and /work/SRC/openSUSE:Factory/.ghc-names-th.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-names-th" Thu Aug 31 20:57:27 2017 rev:2 rq:513438 version:0.2.0.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-names-th/ghc-names-th.changes 2016-10-22 13:13:47.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-names-th.new/ghc-names-th.changes 2017-08-31 20:57:29.186792859 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:08 UTC 2017 - psimons(a)suse.com + +- Update to version 0.2.0.3. + +------------------------------------------------------------------- Old: ---- names-th-0.2.0.2.tar.gz New: ---- names-th-0.2.0.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-names-th.spec ++++++ --- /var/tmp/diff_new_pack.yzvq9I/_old 2017-08-31 20:57:29.974682158 +0200 +++ /var/tmp/diff_new_pack.yzvq9I/_new 2017-08-31 20:57:29.978681596 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-names-th # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,20 +18,18 @@ %global pkg_name names-th Name: ghc-%{pkg_name} -Version: 0.2.0.2 +Version: 0.2.0.3 Release: 0 Summary: Manipulate name strings for TH License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-containers-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description This package includes functions to manipulate name string and extra library @@ -51,15 +49,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ names-th-0.2.0.2.tar.gz -> names-th-0.2.0.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/names-th-0.2.0.2/names-th.cabal new/names-th-0.2.0.3/names-th.cabal --- old/names-th-0.2.0.2/names-th.cabal 2016-06-19 07:50:48.000000000 +0200 +++ new/names-th-0.2.0.3/names-th.cabal 2017-07-17 02:56:42.000000000 +0200 @@ -1,5 +1,5 @@ name: names-th -version: 0.2.0.2 +version: 0.2.0.3 synopsis: Manipulate name strings for TH description: This package includes functions to manipulate name string and extra library functions for Template Haskell. @@ -8,11 +8,12 @@ license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino(a)gmail.com -copyright: Copyright (c) 2013-2016 Kei Hibino +copyright: Copyright (c) 2013-2017 Kei Hibino category: Development build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 8.0.1 +tested-with: GHC == 8.2.1 + , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3

1 0

commit ghc-mustache for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-mustache for openSUSE:Factory checked in at 2017-08-31 20:57:25 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-mustache (Old) and /work/SRC/openSUSE:Factory/.ghc-mustache.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-mustache" Thu Aug 31 20:57:25 2017 rev:5 rq:513436 version:2.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-mustache/ghc-mustache.changes 2017-06-04 01:58:01.999421652 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-mustache.new/ghc-mustache.changes 2017-08-31 20:57:27.003099675 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:12 UTC 2017 - psimons(a)suse.com + +- Update to version 2.2.3. + +------------------------------------------------------------------- Old: ---- mustache-2.1.4.tar.gz New: ---- mustache-2.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-mustache.spec ++++++ --- /var/tmp/diff_new_pack.FzgPLK/_old 2017-08-31 20:57:28.286919294 +0200 +++ /var/tmp/diff_new_pack.FzgPLK/_new 2017-08-31 20:57:28.298917608 +0200 @@ -19,7 +19,7 @@ %global pkg_name mustache %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.1.4 +Version: 2.2.3 Release: 0 Summary: A mustache template parser library License: BSD-3-Clause ++++++ mustache-2.1.4.tar.gz -> mustache-2.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/CHANGELOG.md new/mustache-2.2.3/CHANGELOG.md --- old/mustache-2.1.4/CHANGELOG.md 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/CHANGELOG.md 2017-05-21 11:08:53.000000000 +0200 @@ -1,5 +1,22 @@ # Mustache library changelog +## v2.2.3 + +- Quick fix to prevent catchSubstitute from reporting substitutions to the renderer. + +## v2.2.2 + +- Added a function to catch a substitution result + +## v2.2.1 + +- Quickfix for an issue with resolving in context + +## v2.2 + +- changed substitution into a new monad + + easier usage in lambdas and lambdas can now do nested substitution + ## v2.1.4 - Treat Null as falsy in sections @@ -10,7 +27,7 @@ ## v2.1.2 -- Fixed template cahce again, as the spec requires access to the previous cache in partials as well +- Fixed template cache again, as the spec requires access to the previous cache in partials as well ## v2.1.1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/mustache.cabal new/mustache-2.2.3/mustache.cabal --- old/mustache-2.1.4/mustache.cabal 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/mustache.cabal 2017-05-21 11:08:53.000000000 +0200 @@ -1,5 +1,5 @@ name: mustache -version: 2.1.4 +version: 2.2.3 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the @@ -29,13 +29,6 @@ type: git location: git://github.com/JustusAdam/mustache.git -source-repository this - type: git - branch: master - location: git://github.com/JustusAdam/mustache.git - tag: v2.1.4 - - library exposed-modules: Text.Mustache @@ -44,6 +37,7 @@ , Text.Mustache.Compile , Text.Mustache.Render other-modules: Text.Mustache.Internal + , Text.Mustache.Internal.Types other-extensions: NamedFieldPuns , OverloadedStrings , LambdaCase @@ -69,6 +63,8 @@ default-language: Haskell2010 ghc-options: -Wall + default-extensions: LambdaCase + , TupleSections executable haskell-mustache diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Internal/Types.hs new/mustache-2.2.3/src/Text/Mustache/Internal/Types.hs --- old/mustache-2.1.4/src/Text/Mustache/Internal/Types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mustache-2.2.3/src/Text/Mustache/Internal/Types.hs 2017-05-18 13:52:32.000000000 +0200 @@ -0,0 +1,356 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +module Text.Mustache.Internal.Types where + + +import Control.Arrow +import Control.Monad.RWS hiding (lift) +import qualified Data.Aeson as Aeson +import Data.Foldable (toList) +import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS +import qualified Data.Map as Map +import Data.Scientific +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import Data.Text +import qualified Data.Text.Lazy as LT +import qualified Data.Vector as V +import Language.Haskell.TH.Lift (Lift (lift), deriveLift) + + +-- | Type of errors we may encounter during substitution. +data SubstitutionError + = VariableNotFound [Key] -- ^ The template contained a variable for which there was no data counterpart in the current context + | InvalidImplicitSectionContextType String -- ^ When substituting an implicit section the current context had an unsubstitutable type + | InvertedImplicitSection -- ^ Inverted implicit sections should never occur + | SectionTargetNotFound [Key] -- ^ The template contained a section for which there was no data counterpart in the current context + | PartialNotFound FilePath -- ^ The template contained a partial for which there was no data counterpart in the current context + | DirectlyRenderedValue Value -- ^ A complex value such as an Object or Array was directly rendered into the template (warning) + deriving (Show) + + +tellError :: SubstitutionError -> SubM () +tellError e = SubM $ tell ([e], []) + + +tellSuccess :: Text -> SubM () +tellSuccess s = SubM $ tell ([], [s]) + + +newtype SubM a = SubM { runSubM' :: RWS (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a } deriving (Monad, Functor, Applicative, MonadReader (Context Value, TemplateCache)) + +runSubM :: SubM a -> Context Value -> TemplateCache -> ([SubstitutionError], [Text]) +runSubM comp ctx cache = snd $ evalRWS (runSubM' comp) (ctx, cache) () + +shiftContext :: Context Value -> SubM a -> SubM a +shiftContext = local . first . const + +-- | Search for a key in the current context. +-- +-- The search is conducted inside out mening the current focus +-- is searched first. If the key is not found the outer scopes are recursively +-- searched until the key is found, then 'innerSearch' is called on the result. +search :: [Key] -> SubM (Maybe Value) +search [] = return Nothing +search (key:nextKeys) = (>>= innerSearch nextKeys) <$> go + where + go = asks fst >>= \case + Context parents focus -> do + let searchParents = case parents of + (newFocus: newParents) -> shiftContext (Context newParents newFocus) $ go + _ -> return Nothing + case focus of + Object o -> + case HM.lookup key o of + Just res -> return $ Just res + _ -> searchParents + _ -> searchParents + + +-- | Searches nested scopes navigating inward. Fails if it encunters something +-- other than an object before the key is expended. +innerSearch :: [Key] -> Value -> Maybe Value +innerSearch [] v = Just v +innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys +innerSearch _ _ = Nothing + + + +-- | Syntax tree for a mustache template +type STree = ASTree Text + + +type ASTree α = [Node α] + + +-- | Basic values composing the STree +data Node α + = TextBlock α + | Section DataIdentifier (ASTree α) + | InvertedSection DataIdentifier (ASTree α) + | Variable Bool DataIdentifier + | Partial (Maybe α) FilePath + deriving (Show, Eq) + + +-- | Kinds of identifiers for Variables and sections +data DataIdentifier + = NamedData [Key] + | Implicit + deriving (Show, Eq) + + +-- | A list-like structure used in 'Value' +type Array = V.Vector Value +-- | A map-like structure used in 'Value' +type Object = HM.HashMap Text Value +-- | Source type for constructing 'Object's +type Pair = (Text, Value) + + +-- | Representation of stateful context for the substitution process +data Context α = Context { ctxtParents :: [α], ctxtFocus :: α } + deriving (Eq, Show, Ord) + +-- | Internal value representation +data Value + = Object !Object + | Array !Array + | Number !Scientific + | String !Text + | Lambda (STree -> SubM STree) + | Bool !Bool + | Null + + +instance Show Value where + show (Lambda _) = "Lambda function" + show (Object o) = show o + show (Array a) = show a + show (String s) = show s + show (Number n) = show n + show (Bool b) = show b + show Null = "null" + + +listToMustache' :: ToMustache ω => [ω] -> Value +listToMustache' = Array . V.fromList . fmap toMustache + + +-- | Conversion class +class ToMustache ω where + toMustache :: ω -> Value + listToMustache :: [ω] -> Value + listToMustache = listToMustache' + +instance ToMustache Float where + toMustache = Number . fromFloatDigits + +instance ToMustache Double where + toMustache = Number . fromFloatDigits + +instance ToMustache Integer where + toMustache = Number . fromInteger + +instance ToMustache Int where + toMustache = toMustache . toInteger + +instance ToMustache Char where + toMustache = toMustache . (:[]) + listToMustache = String . pack + +instance ToMustache Value where + toMustache = id + +instance ToMustache Bool where + toMustache = Bool + +instance ToMustache () where + toMustache = const Null + +instance ToMustache ω => ToMustache (Maybe ω) where + toMustache (Just w) = toMustache w + toMustache Nothing = Null + +instance ToMustache Text where + toMustache = String + +instance ToMustache LT.Text where + toMustache = String . LT.toStrict + +instance ToMustache Scientific where + toMustache = Number + +instance ToMustache α => ToMustache [α] where + toMustache = listToMustache + +instance ToMustache ω => ToMustache (Seq.Seq ω) where + toMustache = listToMustache' . toList + +instance ToMustache ω => ToMustache (V.Vector ω) where + toMustache = Array . fmap toMustache + +instance (ToMustache ω) => ToMustache (Map.Map Text ω) where + toMustache = mapInstanceHelper id + +instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where + toMustache = mapInstanceHelper LT.toStrict + +instance (ToMustache ω) => ToMustache (Map.Map String ω) where + toMustache = mapInstanceHelper pack + +mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value +mapInstanceHelper conv = + toMustache + . Map.foldrWithKey + (\k -> HM.insert (conv k) . toMustache) + HM.empty + +instance ToMustache ω => ToMustache (HM.HashMap Text ω) where + toMustache = Object . fmap toMustache + +instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where + toMustache = hashMapInstanceHelper LT.toStrict + +instance ToMustache ω => ToMustache (HM.HashMap String ω) where + toMustache = hashMapInstanceHelper pack + +hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value +hashMapInstanceHelper conv = + toMustache + . HM.foldrWithKey + (\k -> HM.insert (conv k) . toMustache) + HM.empty + +instance ToMustache (STree -> SubM STree) where + toMustache = Lambda + +instance ToMustache Aeson.Value where + toMustache (Aeson.Object o) = Object $ fmap toMustache o + toMustache (Aeson.Array a) = Array $ fmap toMustache a + toMustache (Aeson.Number n) = Number n + toMustache (Aeson.String s) = String s + toMustache (Aeson.Bool b) = Bool b + toMustache Aeson.Null = Null + +instance ToMustache ω => ToMustache (HS.HashSet ω) where + toMustache = listToMustache' . HS.toList + +instance ToMustache ω => ToMustache (Set.Set ω) where + toMustache = listToMustache' . Set.toList + +instance (ToMustache α, ToMustache β) => ToMustache (α, β) where + toMustache (a, b) = toMustache [toMustache a, toMustache b] + +instance (ToMustache α, ToMustache β, ToMustache γ) + => ToMustache (α, β, γ) where + toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c] + +instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ) + => ToMustache (α, β, γ, δ) where + toMustache (a, b, c, d) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + ) => ToMustache (α, β, γ, δ, ε) where + toMustache (a, b, c, d, e) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + ) => ToMustache (α, β, γ, δ, ε, ζ) where + toMustache (a, b, c, d, e, f) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + , ToMustache η + ) => ToMustache (α, β, γ, δ, ε, ζ, η) where + toMustache (a, b, c, d, e, f, g) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + , toMustache g + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + , ToMustache η + , ToMustache θ + ) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where + toMustache (a, b, c, d, e, f, g, h) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + , toMustache g + , toMustache h + ] + +-- | A collection of templates with quick access via their hashed names +type TemplateCache = HM.HashMap String Template + +-- | Type of key used for retrieving data from 'Value's +type Key = Text + +{-| + A compiled Template with metadata. +-} +data Template = Template + { name :: String + , ast :: STree + , partials :: TemplateCache + } deriving (Show) + +instance Lift TemplateCache where + lift m = [| HM.fromList $(lift $ HM.toList m) |] + +instance Lift Text where + lift = lift . unpack + +deriveLift ''DataIdentifier +deriveLift ''Node +deriveLift ''Template + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Render.hs new/mustache-2.2.3/src/Text/Mustache/Render.hs --- old/mustache-2.1.4/src/Text/Mustache/Render.hs 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache/Render.hs 2017-05-21 11:08:53.000000000 +0200 @@ -7,7 +7,11 @@ Stability : experimental Portability : POSIX -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Mustache.Render ( -- * Substitution @@ -15,54 +19,34 @@ -- * Checked substitution , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..) -- * Working with Context - , Context(..), search, innerSearch + , Context(..), search, innerSearch, SubM, substituteNode, substituteAST, catchSubstitute -- * Util , toString ) where -import Control.Applicative ((<|>)) -import Control.Arrow (first, second) +import Control.Arrow (first, second) import Control.Monad -import Data.Foldable (for_) -import Data.HashMap.Strict as HM hiding (keys, map) -import Data.Maybe (fromMaybe) - -import Data.Scientific (floatingOrInteger) -import Data.Text as T (Text, isSuffixOf, pack, replace, - stripSuffix) -import qualified Data.Vector as V -import Prelude hiding (length, lines, unlines) +import Data.Foldable (for_) +import Data.HashMap.Strict as HM hiding (keys, map) +import Data.Maybe (fromMaybe) + +import Data.Scientific (floatingOrInteger) +import Data.Text as T (Text, isSuffixOf, pack, + replace, stripSuffix) +import qualified Data.Vector as V +import Prelude hiding (length, lines, unlines) +import Control.Monad.Reader import Control.Monad.Writer -import qualified Data.Text as T +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT import Text.Mustache.Internal +import Text.Mustache.Internal.Types import Text.Mustache.Types --- | Type of errors we may encounter during substitution. -data SubstitutionError - = VariableNotFound [Key] -- ^ The template contained a variable for which there was no data counterpart in the current context - | InvalidImplicitSectionContextType String -- ^ When substituting an implicit section the current context had an unsubstitutable type - | InvertedImplicitSection -- ^ Inverted implicit sections should never occur - | SectionTargetNotFound [Key] -- ^ The template contained a section for which there was no data counterpart in the current context - | PartialNotFound FilePath -- ^ The template contained a partial for which there was no data counterpart in the current context - | DirectlyRenderedValue Value -- ^ A complex value such as an Object or Array was directly rendered into the template (warning) - deriving (Show) - - -type Substitution = Writer ([SubstitutionError], [Text]) - - -tellError :: SubstitutionError -> Substitution () -tellError e = tell ([e], []) - - -tellSuccess :: Text -> Substitution () -tellSuccess s = tell ([], [s]) - - {-| Substitutes all mustache defined tokens (or tags) for values found in the provided data structure. @@ -115,86 +99,92 @@ -} checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text) checkedSubstituteValue template dataStruct = - second T.concat $ execWriter $ substituteASTWithValAndCache (ast template) (partials template) (Context mempty dataStruct) + second T.concat $ runSubM (substituteAST (ast template)) (Context mempty dataStruct) (partials template) -substituteASTWithValAndCache :: STree -> TemplateCache -> Context Value -> Substitution () -substituteASTWithValAndCache cAst cPartials ctx = - mapM_ (substitute' ctx) cAst +-- | Catch the results of running the inner substitution. +catchSubstitute :: SubM a -> SubM (a, Text) +catchSubstitute = fmap (second (T.concat . snd)) . SubM . hideResults . listen . runSubM' where - -- Main substitution function - substitute' :: Context Value -> Node Text -> Substitution () - - -- subtituting text - substitute' _ (TextBlock t) = tellSuccess t + hideResults = censor (\(errs, _) -> (errs, [])) - -- substituting a whole section (entails a focus shift) - substitute' (Context parents focus@(Array a)) (Section Implicit secSTree) - | V.null a = return () - | otherwise = for_ a $ \focus' -> - let - newContext = Context (focus:parents) focus' - in - mapM_ (substitute' newContext) secSTree - substitute' context@(Context _ (Object _)) (Section Implicit secSTree) = - mapM_ (substitute' context) secSTree - substitute' (Context _ v) (Section Implicit _) = - tellError $ InvalidImplicitSectionContextType $ showValueType v - substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) = - case search context secName of - Just arr@(Array arrCont) -> - if V.null arrCont - then return () - else for_ arrCont $ \focus' -> - let - newContext = Context (arr:focus:parents) focus' - in - mapM_ (substitute' newContext) secSTree - Just (Bool False) -> return () - Just Null -> return () - Just (Lambda l) -> mapM_ (substitute' context) (l context secSTree) - Just focus' -> - let - newContext = Context (focus:parents) focus' - in - mapM_ (substitute' newContext) secSTree - Nothing -> tellError $ SectionTargetNotFound secName - - -- substituting an inverted section - substitute' _ (InvertedSection Implicit _ ) = tellError InvertedImplicitSection - substitute' context (InvertedSection (NamedData secName) invSecSTree) = - case search context secName of - Just (Bool False) -> contents - Just (Array a) | V.null a -> contents - Nothing -> contents - _ -> return () - where - contents = mapM_ (substitute' context) invSecSTree +-- | Substitute an entire 'STree' rather than just a single 'Node' +substituteAST :: STree -> SubM () +substituteAST = mapM_ substituteNode + + +-- | Main substitution function +substituteNode :: Node Text -> SubM () + +-- subtituting text +substituteNode (TextBlock t) = tellSuccess t + +-- substituting a whole section (entails a focus shift) +substituteNode (Section Implicit secSTree) = + asks fst >>= \case + Context parents focus@(Array a) + | V.null a -> return () + | otherwise -> for_ a $ \focus' -> + let newContext = Context (focus:parents) focus' + in shiftContext newContext $ substituteAST secSTree + Context _ (Object _) -> substituteAST secSTree + Context _ v -> tellError $ InvalidImplicitSectionContextType $ showValueType v + +substituteNode (Section (NamedData secName) secSTree) = + search secName >>= \case + Just arr@(Array arrCont) -> + if V.null arrCont + then return () + else do + Context parents focus <- asks fst + for_ arrCont $ \focus' -> + let newContext = Context (arr:focus:parents) focus' + in shiftContext newContext $ substituteAST secSTree + Just (Bool False) -> return () + Just Null -> return () + Just (Lambda l) -> substituteAST =<< l secSTree + Just focus' -> do + Context parents focus <- asks fst + let newContext = Context (focus:parents) focus' + shiftContext newContext $ substituteAST secSTree + Nothing -> tellError $ SectionTargetNotFound secName + +-- substituting an inverted section +substituteNode (InvertedSection Implicit _) = tellError InvertedImplicitSection +substituteNode (InvertedSection (NamedData secName) invSecSTree) = + search secName >>= \case + Just (Bool False) -> contents + Just (Array a) | V.null a -> contents + Nothing -> contents + _ -> return () + where + contents = mapM_ substituteNode invSecSTree - -- substituting a variable - substitute' (Context _ current) (Variable _ Implicit) = toString current >>= tellSuccess - substitute' context (Variable escaped (NamedData varName)) = - maybe - (tellError $ VariableNotFound varName) - (toString >=> tellSuccess . (if escaped then escapeXMLText else id)) - $ search context varName - - -- substituting a partial - substitute' context (Partial indent pName) = - case HM.lookup pName cPartials of - Nothing -> tellError $ PartialNotFound pName - Just t -> - let ast' = handleIndent indent $ ast t - in substituteASTWithValAndCache ast' (partials t `HM.union` cPartials) context +-- substituting a variable +substituteNode (Variable _ Implicit) = asks (ctxtFocus . fst) >>= toString >>= tellSuccess +substituteNode (Variable escaped (NamedData varName)) = + maybe + (tellError $ VariableNotFound varName) + (toString >=> tellSuccess . (if escaped then escapeXMLText else id)) + =<< search varName + +-- substituting a partial +substituteNode (Partial indent pName) = do + cPartials <- asks snd + case HM.lookup pName cPartials of + Nothing -> tellError $ PartialNotFound pName + Just t -> + let ast' = handleIndent indent $ ast t + in local (second (partials t `HM.union`)) $ substituteAST ast' showValueType :: Value -> String -showValueType Null = "Null" +showValueType Null = "Null" showValueType (Object _) = "Object" -showValueType (Array _) = "Array" +showValueType (Array _) = "Array" showValueType (String _) = "String" showValueType (Lambda _) = "Lambda" showValueType (Number _) = "Number" -showValueType (Bool _) = "Bool" +showValueType (Bool _) = "Bool" handleIndent :: Maybe Text -> STree -> STree @@ -204,36 +194,14 @@ preface = if T.null indentation then [] else [TextBlock indentation] content = if T.null indentation then ast' - else - let - fullIndented = fmap (indentBy indentation) ast' - dropper (TextBlock t) = TextBlock $ - if ("\n" <> indentation) `isSuffixOf` t - then fromMaybe t $ stripSuffix indentation t - else t - dropper a = a - in - reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) - - --- | Search for a key in the current context. --- --- The search is conducted inside out mening the current focus --- is searched first. If the key is not found the outer scopes are recursively --- searched until the key is found, then 'innerSearch' is called on the result. -search :: Context Value -> [Key] -> Maybe Value -search _ [] = Nothing -search ctx keys@(_:nextKeys) = go ctx keys >>= innerSearch nextKeys - where - go _ [] = Nothing - go (Context parents focus) val@(x:_) = searchCurrentContext <|> searchParentContext + else reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) where - searchCurrentContext = case focus of - (Object o) -> HM.lookup x o - _ -> Nothing - searchParentContext = do - (newFocus, newParents) <- uncons parents - go (Context newParents newFocus) val + fullIndented = fmap (indentBy indentation) ast' + dropper (TextBlock t) = TextBlock $ + if ("\n" <> indentation) `isSuffixOf` t + then fromMaybe t $ stripSuffix indentation t + else t + dropper a = a indentBy :: Text -> Node Text -> Node Text indentBy indent p@(Partial (Just indent') name') @@ -244,18 +212,33 @@ indentBy _ a = a --- | Searches nested scopes navigating inward. Fails if it encunters something --- other than an object before the key is expended. -innerSearch :: [Key] -> Value -> Maybe Value -innerSearch [] v = Just v -innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys -innerSearch _ _ = Nothing - -- | Converts values to Text as required by the mustache standard -toString :: Value -> Substitution Text +toString :: Value -> SubM Text toString (String t) = return t toString (Number n) = return $ either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer) toString e = do tellError $ DirectlyRenderedValue e return $ pack $ show e + + +instance ToMustache (Context Value -> STree -> STree) where + toMustache f = Lambda $ (<$> askContext) . flip f + +instance ToMustache (Context Value -> STree -> Text) where + toMustache = lambdaHelper id + +instance ToMustache (Context Value -> STree -> LT.Text) where + toMustache = lambdaHelper LT.toStrict + +instance ToMustache (Context Value -> STree -> String) where + toMustache = lambdaHelper pack + +lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value +lambdaHelper conv f = Lambda $ (<$> askContext) . wrapper + where + wrapper :: STree -> Context Value -> STree + wrapper lSTree c = [TextBlock $ conv $ f c lSTree] + +instance ToMustache (STree -> SubM Text) where + toMustache f = Lambda (fmap (return . TextBlock) . f) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache/Types.hs new/mustache-2.2.3/src/Text/Mustache/Types.hs --- old/mustache-2.1.4/src/Text/Mustache/Types.hs 2017-03-30 19:35:27.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache/Types.hs 2017-05-18 12:56:04.000000000 +0200 @@ -7,12 +7,6 @@ Stability : experimental Portability : POSIX -} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} module Text.Mustache.Types ( -- * Types for the Parser / Template @@ -31,293 +25,17 @@ , ToMustache, toMustache, mFromJSON -- ** Representation , Array, Object, Pair + , SubM, askContext, askPartials , Context(..) ) where -import qualified Data.Aeson as Aeson -import Data.Foldable (toList) -import qualified Data.HashMap.Strict as HM -import qualified Data.HashSet as HS -import qualified Data.Map as Map -import Data.Scientific -import qualified Data.Sequence as Seq -import qualified Data.Set as Set -import Data.Text -import qualified Data.Text.Lazy as LT -import qualified Data.Vector as V -import Language.Haskell.TH.Lift (Lift (lift), deriveLift) - --- | Syntax tree for a mustache template -type STree = ASTree Text - - -type ASTree α = [Node α] - - --- | Basic values composing the STree -data Node α - = TextBlock α - | Section DataIdentifier (ASTree α) - | InvertedSection DataIdentifier (ASTree α) - | Variable Bool DataIdentifier - | Partial (Maybe α) FilePath - deriving (Show, Eq) - - --- | Kinds of identifiers for Variables and sections -data DataIdentifier - = NamedData [Key] - | Implicit - deriving (Show, Eq) - - --- | A list-like structure used in 'Value' -type Array = V.Vector Value --- | A map-like structure used in 'Value' -type Object = HM.HashMap Text Value --- | Source type for constructing 'Object's -type Pair = (Text, Value) - - --- | Representation of stateful context for the substitution process -data Context α = Context [α] α - deriving (Eq, Show, Ord) - --- | Internal value representation -data Value - = Object !Object - | Array !Array - | Number !Scientific - | String !Text - | Lambda (Context Value -> STree -> STree) - | Bool !Bool - | Null - - -instance Show Value where - show (Lambda _) = "Lambda function" - show (Object o) = show o - show (Array a) = show a - show (String s) = show s - show (Number n) = show n - show (Bool b) = show b - show Null = "null" - - -listToMustache' :: ToMustache ω => [ω] -> Value -listToMustache' = Array . V.fromList . fmap toMustache - - --- | Conversion class -class ToMustache ω where - toMustache :: ω -> Value - listToMustache :: [ω] -> Value - listToMustache = listToMustache' - -instance ToMustache Float where - toMustache = Number . fromFloatDigits - -instance ToMustache Double where - toMustache = Number . fromFloatDigits - -instance ToMustache Integer where - toMustache = Number . fromInteger - -instance ToMustache Int where - toMustache = toMustache . toInteger - -instance ToMustache Char where - toMustache = toMustache . (:[]) - listToMustache = String . pack - -instance ToMustache Value where - toMustache = id - -instance ToMustache Bool where - toMustache = Bool - -instance ToMustache () where - toMustache = const Null - -instance ToMustache ω => ToMustache (Maybe ω) where - toMustache (Just w) = toMustache w - toMustache Nothing = Null - -instance ToMustache Text where - toMustache = String - -instance ToMustache LT.Text where - toMustache = String . LT.toStrict - -instance ToMustache Scientific where - toMustache = Number - -instance ToMustache α => ToMustache [α] where - toMustache = listToMustache - -instance ToMustache ω => ToMustache (Seq.Seq ω) where - toMustache = listToMustache' . toList - -instance ToMustache ω => ToMustache (V.Vector ω) where - toMustache = Array . fmap toMustache - -instance (ToMustache ω) => ToMustache (Map.Map Text ω) where - toMustache = mapInstanceHelper id - -instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where - toMustache = mapInstanceHelper LT.toStrict - -instance (ToMustache ω) => ToMustache (Map.Map String ω) where - toMustache = mapInstanceHelper pack - -mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value -mapInstanceHelper conv = - toMustache - . Map.foldrWithKey - (\k -> HM.insert (conv k) . toMustache) - HM.empty - -instance ToMustache ω => ToMustache (HM.HashMap Text ω) where - toMustache = Object . fmap toMustache - -instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where - toMustache = hashMapInstanceHelper LT.toStrict - -instance ToMustache ω => ToMustache (HM.HashMap String ω) where - toMustache = hashMapInstanceHelper pack - -hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value -hashMapInstanceHelper conv = - toMustache - . HM.foldrWithKey - (\k -> HM.insert (conv k) . toMustache) - HM.empty - -instance ToMustache (Context Value -> STree -> STree) where - toMustache = Lambda - -instance ToMustache (Context Value -> STree -> Text) where - toMustache = lambdaInstanceHelper id - -instance ToMustache (Context Value -> STree -> LT.Text) where - toMustache = lambdaInstanceHelper LT.toStrict - -instance ToMustache (Context Value -> STree -> String) where - toMustache = lambdaInstanceHelper pack - -lambdaInstanceHelper :: (a -> Text) -> (Context Value -> STree -> a) -> Value -lambdaInstanceHelper conv f = Lambda wrapper - where - wrapper :: Context Value -> STree -> STree - wrapper c lSTree = return . TextBlock $ conv $ f c lSTree - -instance ToMustache (STree -> STree) where - toMustache f = toMustache (const f :: Context Value -> STree -> STree) - -instance ToMustache (STree -> Text) where - toMustache f = toMustache wrapper - where - wrapper :: Context Value -> STree -> STree - wrapper _ = (return . TextBlock) . f - -instance ToMustache Aeson.Value where - toMustache (Aeson.Object o) = Object $ fmap toMustache o - toMustache (Aeson.Array a) = Array $ fmap toMustache a - toMustache (Aeson.Number n) = Number n - toMustache (Aeson.String s) = String s - toMustache (Aeson.Bool b) = Bool b - toMustache Aeson.Null = Null - -instance ToMustache ω => ToMustache (HS.HashSet ω) where - toMustache = listToMustache' . HS.toList - -instance ToMustache ω => ToMustache (Set.Set ω) where - toMustache = listToMustache' . Set.toList - -instance (ToMustache α, ToMustache β) => ToMustache (α, β) where - toMustache (a, b) = toMustache [toMustache a, toMustache b] - -instance (ToMustache α, ToMustache β, ToMustache γ) - => ToMustache (α, β, γ) where - toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c] - -instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ) - => ToMustache (α, β, γ, δ) where - toMustache (a, b, c, d) = toMustache - [ toMustache a - , toMustache b - , toMustache c - , toMustache d - ] - -instance ( ToMustache α - , ToMustache β - , ToMustache γ - , ToMustache δ - , ToMustache ε - ) => ToMustache (α, β, γ, δ, ε) where - toMustache (a, b, c, d, e) = toMustache - [ toMustache a - , toMustache b - , toMustache c - , toMustache d - , toMustache e - ] - -instance ( ToMustache α - , ToMustache β - , ToMustache γ - , ToMustache δ - , ToMustache ε - , ToMustache ζ - ) => ToMustache (α, β, γ, δ, ε, ζ) where - toMustache (a, b, c, d, e, f) = toMustache - [ toMustache a - , toMustache b - , toMustache c - , toMustache d - , toMustache e - , toMustache f - ] - -instance ( ToMustache α - , ToMustache β - , ToMustache γ - , ToMustache δ - , ToMustache ε - , ToMustache ζ - , ToMustache η - ) => ToMustache (α, β, γ, δ, ε, ζ, η) where - toMustache (a, b, c, d, e, f, g) = toMustache - [ toMustache a - , toMustache b - , toMustache c - , toMustache d - , toMustache e - , toMustache f - , toMustache g - ] - -instance ( ToMustache α - , ToMustache β - , ToMustache γ - , ToMustache δ - , ToMustache ε - , ToMustache ζ - , ToMustache η - , ToMustache θ - ) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where - toMustache (a, b, c, d, e, f, g, h) = toMustache - [ toMustache a - , toMustache b - , toMustache c - , toMustache d - , toMustache e - , toMustache f - , toMustache g - , toMustache h - ] +import Control.Monad.Reader +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HM +import Data.Text (Text) +import Text.Mustache.Internal.Types + -- | Convenience function for creating Object values. -- @@ -384,27 +102,9 @@ mFromJSON = toMustache . Aeson.toJSON --- | A collection of templates with quick access via their hashed names -type TemplateCache = HM.HashMap String Template +askContext :: SubM (Context Value) +askContext = asks fst --- | Type of key used for retrieving data from 'Value's -type Key = Text -{-| - A compiled Template with metadata. --} -data Template = Template - { name :: String - , ast :: STree - , partials :: TemplateCache - } deriving (Show) - -instance Lift TemplateCache where - lift m = [| HM.fromList $(lift $ HM.toList m) |] - -instance Lift Text where - lift = lift . unpack - -deriveLift ''DataIdentifier -deriveLift ''Node -deriveLift ''Template +askPartials :: SubM TemplateCache +askPartials = asks snd diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/src/Text/Mustache.hs new/mustache-2.2.3/src/Text/Mustache.hs --- old/mustache-2.1.4/src/Text/Mustache.hs 2017-03-30 19:35:27.000000000 +0200 +++ new/mustache-2.2.3/src/Text/Mustache.hs 2017-05-20 11:58:30.000000000 +0200 @@ -171,8 +171,17 @@ , substituteValue, checkedSubstituteValue - -- ** Data Conversion + -- ** In Lambdas + + , substituteNode, substituteAST, catchSubstitute + + -- * Data Conversion , ToMustache, toMustache, object, (~>), (~=) + + -- ** Utilities for lambdas + + , overText + ) where @@ -180,3 +189,9 @@ import Text.Mustache.Compile import Text.Mustache.Render import Text.Mustache.Types +import qualified Data.Text as T + + +-- | Creates a 'Lambda' which first renders the contained section and then applies the supplied function +overText :: (T.Text -> T.Text) -> Value +overText f = toMustache $ fmap (f . snd) . catchSubstitute . substituteAST diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mustache-2.1.4/test/unit/Spec.hs new/mustache-2.2.3/test/unit/Spec.hs --- old/mustache-2.1.4/test/unit/Spec.hs 2017-05-13 21:10:14.000000000 +0200 +++ new/mustache-2.2.3/test/unit/Spec.hs 2017-05-21 11:08:53.000000000 +0200 @@ -185,6 +185,22 @@ (object ["section" ~> ([] :: [T.Text])]) `shouldBe` "" + it "substitutes a lambda by applying lambda to contained text" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t"]]) + (object ["lambda" ~> (overText T.toUpper)]) + `shouldBe` "T" + + + it "substitutes a lambda by applying lambda to the nested substitution results" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t", Variable escaped (NamedData ["inner"])]]) + (object [ "lambda" ~> (overText T.toUpper) + , "inner" ~> ("var" :: T.Text) + ]) + `shouldBe` "TVAR" + + it "substitutes a nested section" $ substitute (toTemplate [Variable escaped (NamedData ["outer", "inner"])])

1 0

commit ghc-monad-skeleton for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-monad-skeleton for openSUSE:Factory checked in at 2017-08-31 20:57:23 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-monad-skeleton (Old) and /work/SRC/openSUSE:Factory/.ghc-monad-skeleton.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-monad-skeleton" Thu Aug 31 20:57:23 2017 rev:3 rq:513434 version:0.1.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-monad-skeleton/ghc-monad-skeleton.changes 2017-04-14 13:38:33.004361556 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-monad-skeleton.new/ghc-monad-skeleton.changes 2017-08-31 20:57:23.707562708 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:44 UTC 2017 - psimons(a)suse.com + +- Update to version 0.1.4. + +------------------------------------------------------------------- Old: ---- monad-skeleton-0.1.3.2.tar.gz New: ---- monad-skeleton-0.1.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-monad-skeleton.spec ++++++ --- /var/tmp/diff_new_pack.DDUSwW/_old 2017-08-31 20:57:24.399465493 +0200 +++ /var/tmp/diff_new_pack.DDUSwW/_new 2017-08-31 20:57:24.407464369 +0200 @@ -18,7 +18,7 @@ %global pkg_name monad-skeleton Name: ghc-%{pkg_name} -Version: 0.1.3.2 +Version: 0.1.4 Release: 0 Summary: Monads of program skeleta License: BSD-3-Clause ++++++ monad-skeleton-0.1.3.2.tar.gz -> monad-skeleton-0.1.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/README.md new/monad-skeleton-0.1.4/README.md --- old/monad-skeleton-0.1.3.2/README.md 2017-03-16 06:48:35.000000000 +0100 +++ new/monad-skeleton-0.1.4/README.md 2017-07-19 08:00:41.000000000 +0200 @@ -23,7 +23,7 @@ ```haskell data Interaction x where - Get :: Interacton String + Get :: Interaction String Put :: String -> Interaction () echo :: Skeleton Interaction () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/monad-skeleton.cabal new/monad-skeleton-0.1.4/monad-skeleton.cabal --- old/monad-skeleton-0.1.3.2/monad-skeleton.cabal 2017-03-16 08:21:29.000000000 +0100 +++ new/monad-skeleton-0.1.4/monad-skeleton.cabal 2017-07-19 07:58:22.000000000 +0200 @@ -1,5 +1,5 @@ name: monad-skeleton -version: 0.1.3.2 +version: 0.1.4 synopsis: Monads of program skeleta description: Fast operational monad library homepage: https://github.com/fumieval/monad-skeleton @@ -26,6 +26,7 @@ exposed-modules: Control.Monad.Skeleton , Control.Monad.Skeleton.Internal , Control.Monad.Zombie + , Control.Monad.Zombie.Internal build-depends: base == 4.* hs-source-dirs: src ghc-options: -Wall diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/src/Control/Monad/Skeleton/Internal.hs new/monad-skeleton-0.1.4/src/Control/Monad/Skeleton/Internal.hs --- old/monad-skeleton-0.1.3.2/src/Control/Monad/Skeleton/Internal.hs 2017-03-16 08:17:20.000000000 +0100 +++ new/monad-skeleton-0.1.4/src/Control/Monad/Skeleton/Internal.hs 2017-07-19 07:57:50.000000000 +0200 @@ -2,18 +2,15 @@ module Control.Monad.Skeleton.Internal (Cat(..), transCat, (|>), viewL, transKleisli) where import Control.Arrow -import Control.Category import Unsafe.Coerce data Cat k a b where - Empty :: Cat k a a Leaf :: k a b -> Cat k a b Tree :: Cat k a b -> Cat k b c -> Cat k a c transCat :: (forall x y. j x y -> k x y) -> Cat j a b -> Cat k a b transCat f (Tree a b) = transCat f a `Tree` transCat f b transCat f (Leaf k) = Leaf (f k) -transCat _ Empty = Empty {-# INLINE transCat #-} (|>) :: Cat k a b -> k b c -> Cat k a c @@ -21,23 +18,15 @@ {-# INLINE (|>) #-} viewL :: forall k a b r. Cat k a b - -> ((a ~ b) => r) + -> (k a b -> r) -> (forall x. k a x -> Cat k x b -> r) -> r -viewL Empty e _ = e -viewL (Leaf k) _ r = k `r` Empty +viewL (Leaf k) e _ = e k viewL (Tree a b) e r = go a b where go :: Cat k a x -> Cat k x b -> r - go Empty t = viewL t e r go (Leaf k) t = r k t go (Tree c d) t = go c (Tree d t) -instance Category (Cat k) where - id = Empty - {-# INLINE id #-} - (.) = flip Tree - {-# INLINE (.) #-} - transKleisli :: (m b -> n b) -> Kleisli m a b -> Kleisli n a b transKleisli f = unsafeCoerce (f Prelude..) {-# INLINE transKleisli #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/src/Control/Monad/Skeleton.hs new/monad-skeleton-0.1.4/src/Control/Monad/Skeleton.hs --- old/monad-skeleton-0.1.3.2/src/Control/Monad/Skeleton.hs 2017-03-16 08:17:17.000000000 +0100 +++ new/monad-skeleton-0.1.4/src/Control/Monad/Skeleton.hs 2017-07-19 07:57:50.000000000 +0200 @@ -8,9 +8,6 @@ , unbone , boned , hoistSkeleton - -- * internal - , Spine(..) - , graftSpine ) where import Control.Arrow import Control.Applicative @@ -21,16 +18,18 @@ -- | Re-add a bone. boned :: MonadView t (Skeleton t) a -> Skeleton t a -boned t = Skeleton (Spine t id) +boned (Return a) = ReturnS a +boned (t :>>= k) = BindS t $ Leaf $ Kleisli k {-# INLINE boned #-} -- | Pick a bone from a 'Skeleton'. debone :: Skeleton t a -> MonadView t (Skeleton t) a -debone (Skeleton (Spine v c)) = case v of - Return a -> viewL c (Return a) $ \(Kleisli k) c' -> case k a of - Skeleton s -> debone $ Skeleton $ graftSpine c' s - t :>>= k -> t :>>= \a -> case k a of - Skeleton s -> Skeleton (graftSpine c s) +debone (ReturnS a) = Return a +debone (BindS t c0) = t :>>= go c0 where + go :: Cat (Kleisli (Skeleton t)) a b -> a -> Skeleton t b + go c a = viewL c (\(Kleisli k) -> k a) $ \(Kleisli k) c' -> case k a of + ReturnS b -> go c' b + BindS t' c'' -> BindS t' (Tree c'' c') -- | Uncommon synonym for 'debone'. unbone :: Skeleton t a -> MonadView t (Skeleton t) a @@ -40,15 +39,15 @@ -- | A skeleton that has only one bone. bone :: t a -> Skeleton t a -bone t = Skeleton (Spine (t :>>= return) id) +bone t = BindS t $ Leaf $ Kleisli ReturnS {-# INLINABLE bone #-} -- | Lift a transformation between bones into transformation between skeletons. hoistSkeleton :: forall s t a. (forall x. s x -> t x) -> Skeleton s a -> Skeleton t a hoistSkeleton f = go where go :: forall x. Skeleton s x -> Skeleton t x - go (Skeleton (Spine v c)) = Skeleton $ Spine (hoistMV f go v) - (transCat (transKleisli go) c) + go (ReturnS a) = ReturnS a + go (BindS t c) = BindS (f t) $ transCat (transKleisli go) c {-# INLINE hoistSkeleton #-} -- | A deconstructed action @@ -76,19 +75,12 @@ Return a -> return a {-# INLINE iterMV #-} --- | The spine of skeleta. -data Spine t m a where - Spine :: MonadView t m a -> Cat (Kleisli m) a b -> Spine t m b - --- | Extend a spine. -graftSpine :: Cat (Kleisli m) a b -> Spine t m a -> Spine t m b -graftSpine c (Spine v d) = Spine v (c . d) -{-# INLINE graftSpine #-} - -- | @'Skeleton' t@ is a monadic skeleton (operational monad) made out of 't'. -- Skeletons can be fleshed out by getting transformed to other monads. -- It provides O(1) ('>>=') and 'debone', the monadic reflection. -newtype Skeleton t a = Skeleton { unSkeleton :: Spine t (Skeleton t) a } +data Skeleton t a where + ReturnS :: a -> Skeleton t a + BindS :: t a -> Cat (Kleisli (Skeleton t)) a b -> Skeleton t b instance Functor (Skeleton t) where fmap = liftM @@ -104,5 +96,6 @@ a <* b = a >>= \x -> b >> return x instance Monad (Skeleton t) where - return a = Skeleton $ Spine (Return a) id - Skeleton (Spine t c) >>= k = Skeleton $ Spine t (c |> Kleisli k) + return = ReturnS + ReturnS a >>= k = k a + BindS t c >>= k = BindS t (c |> Kleisli k) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/src/Control/Monad/Zombie/Internal.hs new/monad-skeleton-0.1.4/src/Control/Monad/Zombie/Internal.hs --- old/monad-skeleton-0.1.3.2/src/Control/Monad/Zombie/Internal.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/monad-skeleton-0.1.4/src/Control/Monad/Zombie/Internal.hs 2017-07-19 07:57:50.000000000 +0200 @@ -0,0 +1,37 @@ +{-# LANGUAGE PolyKinds, GADTs, Rank2Types, ScopedTypeVariables, Trustworthy #-} +module Control.Monad.Zombie.Internal (Cat(..), transCat, (|>), viewL) where + +import Control.Category + +data Cat k a b where + Empty :: Cat k a a + Leaf :: k a b -> Cat k a b + Tree :: Cat k a b -> Cat k b c -> Cat k a c + +transCat :: (forall x y. j x y -> k x y) -> Cat j a b -> Cat k a b +transCat f (Tree a b) = transCat f a `Tree` transCat f b +transCat f (Leaf k) = Leaf (f k) +transCat _ Empty = Empty +{-# INLINE transCat #-} + +(|>) :: Cat k a b -> k b c -> Cat k a c +s |> k = Tree s (Leaf k) +{-# INLINE (|>) #-} + +viewL :: forall k a b r. Cat k a b + -> ((a ~ b) => r) + -> (forall x. k a x -> Cat k x b -> r) + -> r +viewL Empty e _ = e +viewL (Leaf k) _ r = k `r` Empty +viewL (Tree a b) e r = go a b where + go :: Cat k a x -> Cat k x b -> r + go Empty t = viewL t e r + go (Leaf k) t = r k t + go (Tree c d) t = go c (Tree d t) + +instance Category (Cat k) where + id = Empty + {-# INLINE id #-} + (.) = flip Tree + {-# INLINE (.) #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/monad-skeleton-0.1.3.2/src/Control/Monad/Zombie.hs new/monad-skeleton-0.1.4/src/Control/Monad/Zombie.hs --- old/monad-skeleton-0.1.3.2/src/Control/Monad/Zombie.hs 2017-03-16 08:18:14.000000000 +0100 +++ new/monad-skeleton-0.1.4/src/Control/Monad/Zombie.hs 2017-07-19 07:55:25.000000000 +0200 @@ -1,13 +1,23 @@ -{-# LANGUAGE Rank2Types, ScopedTypeVariables #-} +{-# LANGUAGE Rank2Types, ScopedTypeVariables, GADTs #-} module Control.Monad.Zombie where import Control.Applicative import Control.Arrow import Control.Category import Control.Monad import Control.Monad.Skeleton -import Control.Monad.Skeleton.Internal +import Control.Monad.Skeleton.Internal (transKleisli) +import Control.Monad.Zombie.Internal import Prelude hiding (id, (.)) +-- | The spine of skeleta. +data Spine t m a where + Spine :: MonadView t m a -> Cat (Kleisli m) a b -> Spine t m b + +-- | Extend a spine. +graftSpine :: Cat (Kleisli m) a b -> Spine t m a -> Spine t m b +graftSpine c (Spine v d) = Spine v (Tree d c) +{-# INLINE graftSpine #-} + -- | 'Zombie' is a variant of 'Skeleton' which has an 'Alternative' instance. newtype Zombie t a = Zombie { unZombie :: [Spine t (Zombie t) a] }

1 0

commit ghc-matrices for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-matrices for openSUSE:Factory checked in at 2017-08-31 20:57:20 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-matrices (Old) and /work/SRC/openSUSE:Factory/.ghc-matrices.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-matrices" Thu Aug 31 20:57:20 2017 rev:3 rq:513429 version:0.4.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-matrices/ghc-matrices.changes 2017-01-12 15:50:06.172089561 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-matrices.new/ghc-matrices.changes 2017-08-31 20:57:22.315758260 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:08 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.5. + +------------------------------------------------------------------- Old: ---- matrices-0.4.4.tar.gz New: ---- matrices-0.4.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-matrices.spec ++++++ --- /var/tmp/diff_new_pack.N5Abgu/_old 2017-08-31 20:57:23.435600919 +0200 +++ /var/tmp/diff_new_pack.N5Abgu/_new 2017-08-31 20:57:23.439600357 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-matrices # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name matrices %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.4 +Version: 0.4.5 Release: 0 Summary: Native matrix based on vector License: BSD-3-Clause @@ -39,9 +39,8 @@ %endif %description -This library provide the APIs for creating, indexing, modifying matrices (2d -arrays), including dense and sparse representations. The underling data -structure is vector. +Pure Haskell matrix library, supporting creating, indexing, and modifying +dense/sparse matrices. %package devel Summary: Haskell %{pkg_name} library development files ++++++ matrices-0.4.4.tar.gz -> matrices-0.4.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/matrices-0.4.4/matrices.cabal new/matrices-0.4.5/matrices.cabal --- old/matrices-0.4.4/matrices.cabal 2016-12-04 05:10:18.000000000 +0100 +++ new/matrices-0.4.5/matrices.cabal 2017-07-23 02:38:09.000000000 +0200 @@ -2,20 +2,17 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: matrices -version: 0.4.4 +version: 0.4.5 synopsis: native matrix based on vector -description: This library provide the APIs for creating, indexing, - modifying matrices (2d arrays), including dense and - sparse representations. The underling data - structure is vector. +description: Pure Haskell matrix library, supporting creating, indexing, + and modifying dense/sparse matrices. license: BSD3 license-file: LICENSE author: Kai Zhang maintainer: kai(a)kzhang.org -copyright: (c) 2015,2016 Kai Zhang +copyright: (c) 2015-2017 Kai Zhang category: Data build-type: Simple --- extra-source-files: cabal-version: >=1.10 library @@ -36,12 +33,10 @@ ghc-options: -Wall -funbox-strict-fields - -- other-modules: - build-depends: base >=4.8 && <5 , deepseq - , vector >=0.9 + , vector >=0.11 , primitive hs-source-dirs: src diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/matrices-0.4.4/src/Data/Matrix/Dense/Generic.hs new/matrices-0.4.5/src/Data/Matrix/Dense/Generic.hs --- old/matrices-0.4.4/src/Data/Matrix/Dense/Generic.hs 2016-12-04 05:08:20.000000000 +0100 +++ new/matrices-0.4.5/src/Data/Matrix/Dense/Generic.hs 2017-07-23 02:31:10.000000000 +0200 @@ -53,11 +53,14 @@ , Data.Matrix.Dense.Generic.foldl -- * Mapping - , imap , Data.Matrix.Dense.Generic.map + , imap + -- * Monadic mapping , mapM + , imapM , mapM_ + , imapM_ , forM , forM_ @@ -117,7 +120,7 @@ type instance MG.Mutable Matrix = MMatrix --- | row-major matrix supporting efficient slice +-- | Row-major matrix supporting efficient slice data Matrix v a = Matrix !Int -- number of rows !Int -- number of cols !Int -- physical row dimension @@ -268,29 +271,50 @@ force m@(Matrix r c _ _ _) = MG.fromVector (r,c) . G.force . MG.flatten $ m {-# INLINE force #-} +map :: (G.Vector v a, G.Vector v b) => (a -> b) -> Matrix v a -> Matrix v b +map f m@(Matrix r c _ _ _) = MG.fromVector (r,c) $ G.map f . MG.flatten $ m +{-# INLINE map #-} + imap :: (G.Vector v a, G.Vector v b) => ((Int, Int) -> a -> b) -> Matrix v a -> Matrix v b imap f m@(Matrix r c _ _ _) = MG.fromVector (r,c) $ G.imap f' . MG.flatten $ m where f' i = f (i `div` c, i `mod` c) {-# INLINE imap #-} -map :: (G.Vector v a, G.Vector v b) => (a -> b) -> Matrix v a -> Matrix v b -map f m@(Matrix r c _ _ _) = MG.fromVector (r,c) $ G.map f . MG.flatten $ m -{-# INLINE map #-} - foldl :: G.Vector v b => (a -> b -> a) -> a -> Matrix v b -> a foldl f acc m = G.foldl f acc . MG.flatten $ m {-# INLINE foldl #-} -mapM :: (G.Vector v a, G.Vector v b, Monad m) => (a -> m b) -> Matrix v a -> m (Matrix v b) -mapM f m@(Matrix r c _ _ _) = liftM (MG.fromVector (r,c)) . G.mapM f . MG.flatten $ m +mapM :: (G.Vector v a, G.Vector v b, Monad m) + => (a -> m b) -> Matrix v a -> m (Matrix v b) +mapM f m@(Matrix r c _ _ _) = liftM (MG.fromVector (r,c)) $ G.mapM f $ MG.flatten m {-# INLINE mapM #-} +-- | O(m*n) Apply the monadic action to every element and its index, +-- yielding a matrix of results. +imapM :: (G.Vector v a, G.Vector v b, Monad m) + => ((Int, Int) -> a -> m b) -> Matrix v a -> m (Matrix v b) +imapM f m@(Matrix r c _ _ _) = fmap (MG.fromVector (r,c)) $ G.imapM f' $ + MG.flatten m + where + f' i = f (i `div` c, i `mod` c) +{-# INLINE imapM #-} + mapM_ :: (G.Vector v a, Monad m) => (a -> m b) -> Matrix v a -> m () mapM_ f = G.mapM_ f . MG.flatten {-# INLINE mapM_ #-} -forM :: (G.Vector v a, G.Vector v b, Monad m) => Matrix v a -> (a -> m b) -> m (Matrix v b) +-- | O(m*n) Apply the monadic action to every element and its index, +-- ignoring the results. +imapM_ :: (G.Vector v a, Monad m) + => ((Int, Int) -> a -> m b) -> Matrix v a -> m () +imapM_ f m@(Matrix _ c _ _ _) = G.imapM_ f' $ MG.flatten m + where + f' i = f (i `div` c, i `mod` c) +{-# INLINE imapM_ #-} + +forM :: (G.Vector v a, G.Vector v b, Monad m) + => Matrix v a -> (a -> m b) -> m (Matrix v b) forM = flip mapM {-# INLINE forM #-}

1 0

commit ghc-mainland-pretty for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-mainland-pretty for openSUSE:Factory checked in at 2017-08-31 20:57:15 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-mainland-pretty (Old) and /work/SRC/openSUSE:Factory/.ghc-mainland-pretty.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-mainland-pretty" Thu Aug 31 20:57:15 2017 rev:2 rq:513427 version:0.6.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-mainland-pretty/ghc-mainland-pretty.changes 2016-11-03 11:13:27.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-mainland-pretty.new/ghc-mainland-pretty.changes 2017-08-31 20:57:16.188619143 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:04 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.1. + +------------------------------------------------------------------- Old: ---- mainland-pretty-0.4.1.4.tar.gz New: ---- mainland-pretty-0.6.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-mainland-pretty.spec ++++++ --- /var/tmp/diff_new_pack.3IMkPZ/_old 2017-08-31 20:57:17.956370768 +0200 +++ /var/tmp/diff_new_pack.3IMkPZ/_new 2017-08-31 20:57:17.968369082 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-mainland-pretty # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,21 +18,20 @@ %global pkg_name mainland-pretty Name: ghc-%{pkg_name} -Version: 0.4.1.4 +Version: 0.6.1 Release: 0 Summary: Pretty printing designed for printing source code License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-containers-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-srcloc-devel BuildRequires: ghc-text-devel +BuildRequires: ghc-transformers-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Pretty printing designed for printing source code based on Wadler's paper /A @@ -56,15 +55,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ mainland-pretty-0.4.1.4.tar.gz -> mainland-pretty-0.6.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mainland-pretty-0.4.1.4/LICENSE new/mainland-pretty-0.6.1/LICENSE --- old/mainland-pretty-0.4.1.4/LICENSE 2016-05-02 00:52:51.000000000 +0200 +++ new/mainland-pretty-0.6.1/LICENSE 2017-06-17 21:05:09.000000000 +0200 @@ -48,7 +48,7 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -Copyright (c) 2015-2016 +Copyright (c) 2015-2017 Drexel University. Redistribution and use in source and binary forms, with or without diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mainland-pretty-0.4.1.4/Text/PrettyPrint/Mainland/Class.hs new/mainland-pretty-0.6.1/Text/PrettyPrint/Mainland/Class.hs --- old/mainland-pretty-0.4.1.4/Text/PrettyPrint/Mainland/Class.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mainland-pretty-0.6.1/Text/PrettyPrint/Mainland/Class.hs 2017-06-17 21:05:09.000000000 +0200 @@ -0,0 +1,273 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Text.PrettyPrint.Mainland +-- Copyright : (c) 2006-2011 Harvard University +-- (c) 2011-2012 Geoffrey Mainland +-- (c) 2015-2017 Drexel University +-- License : BSD-style +-- Maintainer : mainland(a)drexel.edu +-- +-- Stability : provisional +-- Portability : portable +-- +-- This module is based on /A Prettier Printer/ by Phil Wadler in +-- /The Fun of Programming/, Jeremy Gibbons and Oege de Moor (eds) +-- <http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf> +-- +-- At the time it was originally written I didn't know about Daan Leijen's +-- pretty printing module based on the same paper. I have since incorporated +-- many of his improvements. This module is geared towards pretty printing +-- source code; its main advantages over other libraries are the ability to +-- automatically track the source locations associated with pretty printed +-- values and output appropriate #line pragmas and the use of +-- 'Data.Text.Lazy.Text' for output. + +module Text.PrettyPrint.Mainland.Class ( + -- * The 'Pretty' type class for pretty printing + Pretty(..), + + pprint + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Complex (Complex, realPart, imagPart) +import Data.Int +import Data.Loc (L(..), + Loc(..), + Pos(..), + posFile) +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.Lazy as L +import Data.Word +import Data.Ratio (Ratio(..), denominator, numerator) + +import Text.PrettyPrint.Mainland + +-- | The 'pprint' function outputs a value of any type that is an instance of +-- 'Pretty' to the standard output device by calling 'ppr' and adding a newline. +pprint :: (Pretty a, MonadIO m) => a -> m () +pprint = liftIO . putDocLn . ppr + +class Pretty a where +#if __GLASGOW_HASKELL__ >= 708 + {-# MINIMAL pprPrec | ppr #-} +#endif + ppr :: a -> Doc + pprPrec :: Int -> a -> Doc + pprList :: [a] -> Doc + + ppr = pprPrec 0 + pprPrec _ = ppr + pprList xs = list (map ppr xs) + +instance Pretty a => Pretty [a] where + ppr = pprList + +instance Pretty a => Pretty (Maybe a) where + pprPrec _ Nothing = empty + pprPrec p (Just a) = pprPrec p a + +instance Pretty Bool where + ppr = bool + +instance Pretty Char where + ppr = char + pprList = string + +instance Pretty Int where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Integer where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Float where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Double where + pprPrec p x = text (showsPrec p x "") + +ratioPrec, ratioPrec1 :: Int +ratioPrec = 7 -- Precedence of ':%' constructor +ratioPrec1 = ratioPrec + 1 + +instance (Integral a, Pretty a) => Pretty (Ratio a) where + pprPrec p x = + parensIf (p > ratioPrec) $ + pprPrec ratioPrec1 (numerator x) <+> char '%' <+> pprPrec ratioPrec1 (denominator x) + +addPrec :: Int +addPrec = 6 -- Precedence of '+' + +instance (RealFloat a, Pretty a) => Pretty (Complex a) where + pprPrec p x = + parensIf (p > addPrec) $ + pprPrec addPrec (realPart x) <+> text ":+" <+> pprPrec addPrec (imagPart x) + +instance Pretty Word8 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Word16 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Word32 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Word64 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Int8 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Int16 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Int32 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty Int64 where + pprPrec p x = text (showsPrec p x "") + +instance Pretty T.Text where + ppr = strictText + +instance Pretty L.Text where + ppr = lazyText + +instance Pretty Doc where + ppr doc = doc + +instance Pretty Pos where + ppr p@(Pos _ l c _) = + text (posFile p) <> colon <> ppr l <> colon <> ppr c + +instance Pretty Loc where + ppr NoLoc = text "<no location info>" + + ppr (Loc p1@(Pos f1 l1 c1 _) p2@(Pos f2 l2 c2 _)) + | f1 == f2 = text (posFile p1) <> colon <//> pprLineCol l1 c1 l2 c2 + | otherwise = ppr p1 <> text "-" <> ppr p2 + where + pprLineCol :: Int -> Int -> Int -> Int -> Doc + pprLineCol l1 c1 l2 c2 + | l1 == l2 && c1 == c2 = ppr l1 <//> colon <//> ppr c1 + | l1 == l2 && c1 /= c2 = ppr l1 <//> colon <//> + ppr c1 <> text "-" <> ppr c2 + | otherwise = ppr l1 <//> colon <//> ppr c1 + <> text "-" <> + ppr l2 <//> colon <//> ppr c2 + +instance Pretty x => Pretty (L x) where + pprPrec p (L _ x) = pprPrec p x + +instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where + ppr = pprList . Map.toList + +instance Pretty a => Pretty (Set.Set a) where + ppr = pprList . Set.toList + +instance Pretty () where + ppr () = + tuple [] + +instance (Pretty a, Pretty b) + => Pretty (a, b) where + ppr (a, b) = + tuple [ppr a, ppr b] + +instance (Pretty a, Pretty b, Pretty c) + => Pretty (a, b, c) where + ppr (a, b, c) = + tuple [ppr a, ppr b, ppr c] + +instance (Pretty a, Pretty b, Pretty c, Pretty d) + => Pretty (a, b, c, d) where + ppr (a, b, c, d) = + tuple [ppr a, ppr b, ppr c, ppr d] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) + => Pretty (a, b, c, d, e) where + ppr (a, b, c, d, e) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f) + => Pretty (a, b, c, d, e, f) where + ppr (a, b, c, d, e, f) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g) + => Pretty (a, b, c, d, e, f, g) where + ppr (a, b, c, d, e, f, g) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h) + => Pretty (a, b, c, d, e, f, g, h) where + ppr (a, b, c, d, e, f, g, h) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i) + => Pretty (a, b, c, d, e, f, g, h, i) where + ppr (a, b, c, d, e, f, g, h, i) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j) + => Pretty (a, b, c, d, e, f, g, h, i, j) where + ppr (a, b, c, d, e, f, g, h, i, j) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, + Pretty k) + => Pretty (a, b, c, d, e, f, g, h, i, j, k) where + ppr (a, b, c, d, e, f, g, h, i, j, k) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j, + ppr k] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, + Pretty k, Pretty l) + => Pretty (a, b, c, d, e, f, g, h, i, j, k, l) where + ppr (a, b, c, d, e, f, g, h, i, j, k, l) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j, + ppr k, ppr l] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, + Pretty k, Pretty l, Pretty m) + => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m) where + ppr (a, b, c, d, e, f, g, h, i, j, k, l, m) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j, + ppr k, ppr l, ppr m] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, + Pretty k, Pretty l, Pretty m, Pretty n) + => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where + ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j, + ppr k, ppr l, ppr m, ppr n] + +instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, + Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, + Pretty k, Pretty l, Pretty m, Pretty n, Pretty o) + => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where + ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = + tuple [ppr a, ppr b, ppr c, ppr d, ppr e, + ppr f, ppr g, ppr h, ppr i, ppr j, + ppr k, ppr l, ppr m, ppr n, ppr o] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mainland-pretty-0.4.1.4/Text/PrettyPrint/Mainland.hs new/mainland-pretty-0.6.1/Text/PrettyPrint/Mainland.hs --- old/mainland-pretty-0.4.1.4/Text/PrettyPrint/Mainland.hs 2016-05-02 00:52:51.000000000 +0200 +++ new/mainland-pretty-0.6.1/Text/PrettyPrint/Mainland.hs 2017-06-17 21:05:09.000000000 +0200 @@ -2,7 +2,7 @@ -- Module : Text.PrettyPrint.Mainland -- Copyright : (c) 2006-2011 Harvard University -- (c) 2011-2012 Geoffrey Mainland --- (c) 2015-2016 Drexel University +-- (c) 2015-2017 Drexel University -- License : BSD-style -- Maintainer : mainland(a)drexel.edu -- @@ -66,19 +66,15 @@ -- * Document rendering render, renderCompact, - displayS, prettyS, pretty, + displayS, prettyS, pretty, prettyCompactS, prettyCompact, displayPragmaS, prettyPragmaS, prettyPragma, displayLazyText, prettyLazyText, displayPragmaLazyText, prettyPragmaLazyText, -- * Document output - putDoc, putDocLn, hPutDoc, hPutDocLn, - - -- * The 'Pretty' type class for pretty printing - Pretty(..) + putDoc, putDocLn, hPutDoc, hPutDocLn ) where -import Data.Int import Data.Loc (L(..), Loc(..), Located(..), @@ -97,8 +93,6 @@ import qualified Data.Text.Lazy.IO as TIO import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B -import Data.Word -import GHC.Real (Ratio(..)) import System.IO (Handle) -- | The abstract type of documents. @@ -310,9 +304,11 @@ x <+> Empty = x x <+> y = x <> space <> y --- | Concatenates two documents with a 'line' in between. +-- | Concatenates two documents with a 'line' in between, with identity 'empty'. (</>) :: Doc -> Doc -> Doc -x </> y = x <> line <> y +Empty </> y = y +x </> Empty = x +x </> y = x <> line <> y -- | Concatenates two documents with a 'softline' in between, with identity -- 'empty'. @@ -684,6 +680,14 @@ pretty :: Int -> Doc -> String pretty w x = prettyS w x "" +-- | Render and display a document compactly. +prettyCompactS :: Doc -> ShowS +prettyCompactS x = displayS (renderCompact x) + +-- | Render and convert a document to a 'String' compactly. +prettyCompact :: Doc -> String +prettyCompact x = prettyCompactS x "" + -- | Display a rendered document with #line pragmas. displayPragmaS :: RDoc -> ShowS displayPragmaS = go @@ -780,10 +784,10 @@ renderPosFile p renderPosLine :: Pos -> B.Builder - renderPosLine = go . renderCompact . ppr . posLine + renderPosLine = go . renderCompact . int . posLine renderPosFile :: Pos -> B.Builder - renderPosFile = go . renderCompact . enclose dquote dquote . ppr . posFile + renderPosFile = go . renderCompact . enclose dquote dquote . string . posFile -- | Render and convert a document to 'L.Text' with #line pragmas. Uses a builder. prettyPragmaLazyText :: Int -> Doc -> L.Text @@ -806,214 +810,3 @@ -- followed by a newline. hPutDocLn :: Handle -> Doc -> IO () hPutDocLn h = TIO.hPutStrLn h . prettyLazyText 80 - -class Pretty a where -#if __GLASGOW_HASKELL__ >= 708 - {-# MINIMAL pprPrec | ppr #-} -#endif - ppr :: a -> Doc - pprPrec :: Int -> a -> Doc - pprList :: [a] -> Doc - - ppr = pprPrec 0 - pprPrec _ = ppr - pprList xs = list (map ppr xs) - -instance Pretty a => Pretty [a] where - ppr = pprList - -instance Pretty a => Pretty (Maybe a) where - pprPrec _ Nothing = empty - pprPrec p (Just a) = pprPrec p a - -instance Pretty Bool where - ppr = bool - -instance Pretty Char where - ppr = char - pprList = string - -instance Pretty Int where - ppr = int - -instance Pretty Integer where - ppr = integer - -instance Pretty Float where - ppr = float - -instance Pretty Double where - ppr = double - -ratioPrec, ratioPrec1 :: Int -ratioPrec = 7 -- Precedence of ':%' constructor -ratioPrec1 = ratioPrec + 1 - -instance (Integral a, Pretty a) => Pretty (Ratio a) where - {-# SPECIALIZE instance Pretty Rational #-} - pprPrec p (x:%y) = - parensIf (p > ratioPrec) $ - pprPrec ratioPrec1 x <+> char '%' <+> pprPrec ratioPrec1 y - -instance Pretty Word8 where - ppr = text . show - -instance Pretty Word16 where - ppr = text . show - -instance Pretty Word32 where - ppr = text . show - -instance Pretty Word64 where - ppr = text . show - -instance Pretty Int8 where - ppr = text . show - -instance Pretty Int16 where - ppr = text . show - -instance Pretty Int32 where - ppr = text . show - -instance Pretty Int64 where - ppr = text . show - -instance Pretty T.Text where - ppr = strictText - -instance Pretty L.Text where - ppr = lazyText - -instance Pretty Pos where - ppr p@(Pos _ l c _) = - text (posFile p) <> colon <> ppr l <> colon <> ppr c - -instance Pretty Loc where - ppr NoLoc = text "<no location info>" - - ppr (Loc p1@(Pos f1 l1 c1 _) p2@(Pos f2 l2 c2 _)) - | f1 == f2 = text (posFile p1) <> colon <//> pprLineCol l1 c1 l2 c2 - | otherwise = ppr p1 <> text "-" <> ppr p2 - where - pprLineCol :: Int -> Int -> Int -> Int -> Doc - pprLineCol l1 c1 l2 c2 - | l1 == l2 && c1 == c2 = ppr l1 <//> colon <//> ppr c1 - | l1 == l2 && c1 /= c2 = ppr l1 <//> colon <//> - ppr c1 <> text "-" <> ppr c2 - | otherwise = ppr l1 <//> colon <//> ppr c1 - <> text "-" <> - ppr l2 <//> colon <//> ppr c2 - -instance Pretty x => Pretty (L x) where - pprPrec p (L _ x) = pprPrec p x - -instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where - ppr = pprList . Map.toList - -instance Pretty a => Pretty (Set.Set a) where - ppr = pprList . Set.toList - -instance Pretty () where - ppr () = - tuple [] - -instance (Pretty a, Pretty b) - => Pretty (a, b) where - ppr (a, b) = - tuple [ppr a, ppr b] - -instance (Pretty a, Pretty b, Pretty c) - => Pretty (a, b, c) where - ppr (a, b, c) = - tuple [ppr a, ppr b, ppr c] - -instance (Pretty a, Pretty b, Pretty c, Pretty d) - => Pretty (a, b, c, d) where - ppr (a, b, c, d) = - tuple [ppr a, ppr b, ppr c, ppr d] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) - => Pretty (a, b, c, d, e) where - ppr (a, b, c, d, e) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f) - => Pretty (a, b, c, d, e, f) where - ppr (a, b, c, d, e, f) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g) - => Pretty (a, b, c, d, e, f, g) where - ppr (a, b, c, d, e, f, g) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h) - => Pretty (a, b, c, d, e, f, g, h) where - ppr (a, b, c, d, e, f, g, h) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i) - => Pretty (a, b, c, d, e, f, g, h, i) where - ppr (a, b, c, d, e, f, g, h, i) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j) - => Pretty (a, b, c, d, e, f, g, h, i, j) where - ppr (a, b, c, d, e, f, g, h, i, j) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, - Pretty k) - => Pretty (a, b, c, d, e, f, g, h, i, j, k) where - ppr (a, b, c, d, e, f, g, h, i, j, k) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j, - ppr k] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, - Pretty k, Pretty l) - => Pretty (a, b, c, d, e, f, g, h, i, j, k, l) where - ppr (a, b, c, d, e, f, g, h, i, j, k, l) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j, - ppr k, ppr l] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, - Pretty k, Pretty l, Pretty m) - => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m) where - ppr (a, b, c, d, e, f, g, h, i, j, k, l, m) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j, - ppr k, ppr l, ppr m] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, - Pretty k, Pretty l, Pretty m, Pretty n) - => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where - ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j, - ppr k, ppr l, ppr m, ppr n] - -instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, - Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, - Pretty k, Pretty l, Pretty m, Pretty n, Pretty o) - => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where - ppr (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = - tuple [ppr a, ppr b, ppr c, ppr d, ppr e, - ppr f, ppr g, ppr h, ppr i, ppr j, - ppr k, ppr l, ppr m, ppr n, ppr o] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mainland-pretty-0.4.1.4/mainland-pretty.cabal new/mainland-pretty-0.6.1/mainland-pretty.cabal --- old/mainland-pretty-0.4.1.4/mainland-pretty.cabal 2016-05-02 00:52:51.000000000 +0200 +++ new/mainland-pretty-0.6.1/mainland-pretty.cabal 2017-06-17 21:05:09.000000000 +0200 @@ -1,15 +1,16 @@ name: mainland-pretty -version: 0.4.1.4 +version: 0.6.1 cabal-version: >= 1.6 license: BSD3 license-file: LICENSE copyright: (c) 2006-2011 Harvard University (c) 2011-2012 Geoffrey Mainland - (c) 2015-2016 Drexel University + (c) 2015-2017 Drexel University author: Geoffrey Mainland <mainland(a)drexel.edu> maintainer: Geoffrey Mainland <mainland(a)drexel.edu> stability: alpha -homepage: http://www.cs.drexel.edu/~mainland/ +homepage: https://github.com/mainland/mainland-pretty +bug-reports: https://github.com/mainland/mainland-pretty/issues category: Text synopsis: Pretty printing designed for printing source code. description: Pretty printing designed for printing source code based on @@ -18,18 +19,21 @@ locations associated with pretty printed values and output appropriate #line pragmas and its ability to produce output in the form of lazy text using a builder. +tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 build-type: Simple library exposed-modules: Text.PrettyPrint.Mainland + Text.PrettyPrint.Mainland.Class build-depends: - base >= 4 && < 5, - containers >= 0.2 && < 0.6, - srcloc >= 0.2 && < 0.6, - text > 0.11 && < 1.3 + base >= 4.5 && < 5, + containers >= 0.2 && < 0.6, + srcloc >= 0.2 && < 0.6, + text > 0.11 && < 1.3, + transformers > 0.3 && < 0.6 source-repository head type: git

1 0