commit ghc-optparse-generic for openSUSE:Factory
![](https://seccdn.libravatar.org/avatar/e2145bc5cf53dda95c308a3c75e8fef3.jpg?s=120&d=mm&r=g)
: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
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@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}-%{version}.tar.gz 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`. + + +{-| 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)
participants (1)
-
root@hilbert.suse.de