optparse-generic 1.1.5 → 1.5.3
raw patch · 6 files changed
Files
- CHANGELOG.md +84/−0
- LICENSE +2/−2
- examples/unwrap-options.hs +22/−0
- examples/unwrap-with-help.hs +24/−0
- optparse-generic.cabal +42/−17
- src/Options/Generic.hs +667/−191
+ CHANGELOG.md view
@@ -0,0 +1,84 @@+1.5.3++- [Link to code in documentation examples](https://github.com/Gabriella439/optparse-generic/pull/118)+- [Allow newer `optparse-applicative`](https://github.com/Gabriella439/optparse-generic/pull/116)+- [Allow newer `time`](https://github.com/Gabriella439/optparse-generic/pull/115)+- [Allow newer `text`, `bytestring`, and `filepath`](https://github.com/Gabriella439/optparse-generic/pull/113)++1.5.2++* [Add support for `OsPath`](https://github.com/Gabriella439/optparse-generic/pull/111)++1.5.1++* [Add `Eq` instances for `(<?>)`, `(<!>)`, and `(<#>)`](https://github.com/Gabriella439/optparse-generic/pull/109)++1.5.0++* BREAKING CHANGE: [Drop support for `system-filepath`](https://github.com/Gabriella439/optparse-generic/pull/106)+* [Add support for more `Data.Time` types](https://github.com/Gabriella439/optparse-generic/pull/102)++1.4.9++* [Add `Data` instance for `Unwrapped`](https://github.com/Gabriella439/optparse-generic/pull/100)++1.4.8++* [Improve handling of `NonEmpty`](https://github.com/Gabriella439/optparse-generic/pull/98)+* [Add `getWithHelpWith`](https://github.com/Gabriella439/Haskell-Optparse-Generic-Library/pull/94)+* [Build against `optparse-applicative-0.17`](https://github.com/Gabriella439/Haskell-Optparse-Generic-Library/pull/92)+* [Build against `text-2.0`](https://github.com/Gabriella439/optparse-generic/pull/91)++1.4.7++* [Derive `Data` instances for exported types](https://github.com/Gabriel439/Haskell-Optparse-Generic-Library/pull/89)++1.4.6++* Use `readField` in default implementation of `parseField`++1.4.5++* [Add ability to set the short name in the type](https://github.com/Gabriel439/Haskell-Optparse-Generic-Library/pull/84)+* [Display default values in `--help` output](https://github.com/Gabriel439/Haskell-Optparse-Generic-Library/pull/83)++1.4.4++* `readIntegralBounded`: use `metavar` in error message++1.4.3++* Export internal `readIntegralBounded` utility+* Build against `optparse-applicative-0.16.0.0`++1.4.2++* New `unwrap` function+ * This is the underlying utility that powers+ `unwrap{Record,RecordPure,WithHelp}`++1.4.1++* Fix broken haddocks++1.4.0++* BREAKING CHANGE: Add support for type-level default values+ * This is a breaking change because the various `parse*` typeclass methods+ now take an additional argument to support this feature++1.3.1++* Export `GenericParseRecord` and `getRecord{,PureWith}`++1.3.0++* BREAKING CHANGE: New `metavar` method for `ParseField` class+ * This field simplifies customizing `ParseField` instances+ * Now you usually only need to override `metavar` now or possibly also+ `readField`, whereas the default behavior for `parseField` should work+ more often+ * This is only a breaking change for data types that use the default+ implementation of `ParseField` but do not derive `Typeable`+ * You can migrate existing code that doesn't compile by just explicitly+ specifying what the `metavar` field should be
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016 Gabriel Gonzalez+Copyright (c) 2016 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,@@ -8,7 +8,7 @@ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.- * Neither the name of Gabriel Gonzalez nor the names of other contributors+ * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+ examples/unwrap-options.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}++import Options.Generic++data Options w = Options+ { a :: w ::: Int <?> "Int option"+ , b :: w ::: Bool <?> "Bool option"+ , c :: w ::: String <?> "String option"+ } deriving Generic++instance ParseRecord (Options Wrapped)+deriving instance Show (Options Unwrapped)++main :: IO ()+main = do+ opts <- unwrapRecord "unwrap-example"+ print (opts :: Options Unwrapped)
+ examples/unwrap-with-help.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}++import Options.Generic++data Options w = Options+ { a :: w ::: Int <?> "Int option -- must be divisible by 10"+ , b :: w ::: Bool <?> "Bool option"+ , c :: w ::: String <?> "String option"+ } deriving Generic++instance ParseRecord (Options Wrapped)+deriving instance Show (Options Unwrapped)++main :: IO ()+main = do+ (opts, help) <- unwrapWithHelp "unwrap-example"+ if (a opts) `rem` 10 == 0+ then print (opts :: Options Unwrapped)+ else help
optparse-generic.cabal view
@@ -1,14 +1,14 @@ Name: optparse-generic-Version: 1.1.5-Cabal-Version: >=1.8.0.2+Version: 1.5.3+Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE-Copyright: 2016 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1-Bug-Reports: https://github.com/Gabriel439/Haskell-Optparse-Generic-Library/issues+Copyright: 2016 Gabriella Gonzalez+Author: Gabriella Gonzalez+Maintainer: GenuineGabriella@gmail.com+Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1+Bug-Reports: https://github.com/Gabriella439/Haskell-Optparse-Generic-Library/issues Synopsis: Auto-generate a command-line parser for your datatype Description: This library auto-generates an @optparse-applicative@-compatible @Parser@ from any data type that derives the @Generic@ interface.@@ -16,23 +16,29 @@ See the documentation in "Options.Generic" for an example of how to use this library Category: System+Extra-Source-Files: CHANGELOG.md Source-Repository head Type: git- Location: https://github.com/Gabriel439/Haskell-Optparse-Generic-Library+ Location: https://github.com/Gabriella439/Haskell-Optparse-Generic-Library Library Hs-Source-Dirs: src Build-Depends:- base >= 4.6 && < 5 ,- 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 ,- void < 0.8 ,- bytestring < 0.11,- semigroups >= 0.5.0 && < 0.19+ base >= 4.8 && < 5 ,+ text < 2.2 ,+ transformers >= 0.2.0.0 && < 0.7 ,+ transformers-compat >= 0.3 && < 0.8 ,+ Only < 0.2 ,+ optparse-applicative >= 0.16.0.0 && < 0.20,+ time >= 1.5 && < 1.15,+ void < 0.8 ,+ bytestring < 0.13,+ filepath < 1.6 + if impl(ghc < 8.0)+ Build-Depends:+ semigroups >= 0.5.0 && < 0.20+ if impl(ghc < 7.8) Build-Depends: singletons >= 0.10.0 && < 1.0 ,@@ -40,3 +46,22 @@ th-desugar < 1.5.1 Exposed-Modules: Options.Generic GHC-Options: -Wall+ Default-Language: Haskell2010++executable optparse-generic-example-unwrap-options+ ghc-options: -Wall+ default-language: Haskell2010+ hs-source-dirs: examples+ main-is: unwrap-options.hs+ build-depends:+ base >= 4.7 && <5,+ optparse-generic++executable optparse-generic-example-unwrap-with-help+ ghc-options: -Wall+ default-language: Haskell2010+ hs-source-dirs: examples+ main-is: unwrap-with-help.hs+ build-depends:+ base >= 4.7 && <5,+ optparse-generic
src/Options/Generic.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-}@@ -20,22 +21,24 @@ -- For example, suppose that you want to parse a record with named fields like -- this: ----- > -- Example.hs--- >--- > {-# LANGUAGE DeriveGeneric #-}--- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Options.Generic--- > --- > data Example = Example { foo :: Int, bar :: Double }--- > deriving (Generic, Show)--- > --- > instance ParseRecord Example--- > --- > main = do--- > x <- getRecord "Test program"--- > print (x :: Example)+-- @+-- -- Example.hs --+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE OverloadedStrings #-}+--+-- import Options.Generic+--+-- data Example = Example { foo :: Int, bar :: Double }+-- deriving (Generic, Show)+--+-- instance 'ParseRecord' Example+--+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: Example)+-- @+-- -- Named fields translate to flags which you can provide in any order: -- -- > $ stack build optparse-generic@@ -46,39 +49,41 @@ -- -- > $ stack runghc Example.hs -- --help -- > Test program--- > +-- > -- > Usage: Example.hs --foo INT --bar DOUBLE--- > +-- > -- > Available options: -- > -h,--help Show this help text -- -- You can also add help descriptions to each field, like this: ----- > {-# LANGUAGE DataKinds #-}--- > {-# LANGUAGE DeriveGeneric #-}--- > {-# LANGUAGE OverloadedStrings #-}--- > {-# LANGUAGE TypeOperators #-}--- > --- > import Options.Generic--- > --- > data Example = Example--- > { foo :: Int <?> "Documentation for the foo flag"--- > , bar :: Double <?> "Documentation for the bar flag"--- > } deriving (Generic, Show)--- > --- > instance ParseRecord Example--- > --- > main = do--- > x <- getRecord "Test program"--- > print (x :: Example)+-- @+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE TypeOperators #-} --+-- import Options.Generic+--+-- data Example = Example+-- { foo :: Int '<?>' "Documentation for the foo flag"+-- , bar :: Double '<?>' "Documentation for the bar flag"+-- } deriving (Generic, Show)+--+-- instance 'ParseRecord' Example+--+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: Example)+-- @+-- -- ... which produces the following @--help@ output: -- -- > $ stack runghc Example.hs -- --help -- > Test program--- > +-- > -- > Usage: Example.hs --foo INT --bar DOUBLE--- > +-- > -- > Available options: -- > -h,--help Show this help text -- > --foo INT Documentation for the foo flag@@ -94,32 +99,58 @@ -- generalize the definition of your record with a parameter 'w', and use -- 'unwrapRecord'. ----- > {-# LANGUAGE DataKinds #-}--- > {-# LANGUAGE DeriveGeneric #-}--- > {-# LANGUAGE FlexibleInstances #-} -- One more extension.--- > {-# LANGUAGE OverloadedStrings #-}--- > {-# LANGUAGE StandaloneDeriving #-} -- To derive Show--- > {-# LANGUAGE TypeOperators #-}--- >--- > import Options.Generic--- >--- > data Example w = Example--- > { foo :: w ::: Int <?> "Documentation for the foo flag"--- > , bar :: w ::: Double <?> "Documentation for the bar flag"--- > } deriving (Generic)--- >--- > instance ParseRecord (Example Wrapped)--- > deriving instance Show (Example Unwrapped)--- >--- > main = do--- > x <- unwrapRecord "Test program"--- > print (x :: Example Unwrapped)+-- @+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE FlexibleInstances #-} -- One more extension.+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE StandaloneDeriving #-} -- To derive Show+-- {-# LANGUAGE TypeOperators #-} ----- @Example Unwrapped@ is equivalent to a record type with simple fields:+-- import Options.Generic --+-- data Example w = Example+-- { foo :: w ::: Int '<?>' "Documentation for the foo flag"+-- , bar :: w ::: Double '<?>' "Documentation for the bar flag"+-- } deriving (Generic)+--+-- instance 'ParseRecord' (Example 'Wrapped')+-- deriving instance Show (Example 'Unwrapped')+--+-- main = do+-- x <- 'unwrapRecord' "Test program"+-- print (x :: Example Unwrapped)+-- @+--+-- @Example 'Unwrapped'@ is equivalent to a record type with simple fields:+-- -- > $ stack runghc Example.hs -- --foo 1 --bar 2.5 -- > Example {foo = 1, bar = 2.5} --+-- You can also add default values to each `Read`able field, like this:+--+-- @+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE TypeOperators #-}+--+-- import Options.Generic+--+-- data Example = Example+-- { foo :: Int '<!>' "1"+-- , bar :: String '<!>' "hello"+-- } deriving (Generic, Show)+--+-- instance 'ParseRecord' Example+--+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: Example)+-- @+--+-- Default values will work alongside help descriptions and unwrapping.+-- -- For the following examples I encourage you to test what @--help@ output they -- generate. --@@ -158,7 +189,7 @@ -- > Example {switch = True, list = [1,2], optional = Just 1, first = First -- > {getFirst = Just 1}, last = Last {getLast = Just 2}, sum = Sum {getSum = -- > 3}, product = Product {getProduct = 2}}--- > +-- > -- > $ stack runghc Example.hs -- > Example {switch = False, list = [], optional = Nothing, first = First -- > {getFirst = Nothing}, second = Last {getLast = Nothing}, sum = Sum {getSum@@ -181,32 +212,38 @@ -- This library also provides out-of-the-box support for many existing types, -- like tuples and `Either`. ----- > {-# LANGUAGE DeriveGeneric #-}--- > {-# LANGUAGE OverloadedStrings #-}--- > --- > import Options.Generic--- > --- > main = do--- > x <- getRecord "Test program"--- > print (x :: Either Double Int)+-- @+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE OverloadedStrings #-} --+-- import Options.Generic+--+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: Either Double Int)+-- @+-- -- > $ stack runghc Example.hs -- left 1.0 -- > Left 1.0 -- > $ stack runghc Example.hs -- right 2 -- > Right 2--- --- > main = do--- > x <- getRecord "Test program"--- > print (x :: (Double, Int)) --+-- @+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: (Double, Int))+-- @+-- -- > $ stack runghc Example.hs -- 1.0 2 -- > (1.0,2) -- -- ... and you can also just parse a single value: ----- > main = do--- > x <- getRecord "Test program"--- > print (x :: Int)+-- @+-- main = do+-- x <- 'getRecord' "Test program"+-- print (x :: Int)+-- @ -- -- > $ stack runghc Example.hs -- 2 -- > 2@@ -237,25 +274,61 @@ -- > 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+ , getRecordWith+ , getWithHelpWith+ , getWithHelp , getRecordPure+ , getRecordPureWith , unwrapRecord+ , unwrapWithHelp , unwrapRecordPure+ , unwrap , ParseRecord(..) , ParseFields(..) , ParseField(..) , Only(..) , getOnly+ , readIntegralBounded , Modifiers(..) , parseRecordWithModifiers , defaultModifiers , lispCaseModifiers+ , firstLetter+ , GenericParseRecord(..) -- * Help , type (<?>)(..)+ , type (<!>)(..)+ , type (<#>)(..) , type (:::) , Wrapped , Unwrapped@@ -274,30 +347,47 @@ import Control.Applicative import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Except (runExcept)+import Control.Monad.Trans.Reader (runReaderT) import Data.Char (isUpper, toLower, toUpper)+import Data.Data (Data)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Maybe (listToMaybe) import Data.Monoid-import Data.List.NonEmpty (NonEmpty((:|)))+import Data.List.NonEmpty (NonEmpty) import Data.Proxy import Data.Text (Text)+import Data.Time.Format.ISO8601 (ISO8601)+import Data.Tuple.Only (Only(..)) import Data.Typeable (Typeable) import Data.Void (Void)-import Filesystem.Path (FilePath)+import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics-import Prelude hiding (FilePath)+import Prelude import Options.Applicative (Parser, ReadM) +import Data.Time+ ( CalendarDiffDays+ , CalendarDiffTime+ , Day+ , LocalTime+ , TimeOfDay+ , TimeZone+ , UTCTime+ , ZonedTime+ )+ import qualified Data.Text import qualified Data.Text.Encoding import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding-import qualified Data.Time.Calendar-import qualified Data.Time.Format+import qualified Data.Time.Format.ISO8601 as ISO8601 import qualified Data.Typeable import qualified Data.ByteString import qualified Data.ByteString.Lazy-import qualified Filesystem.Path.CurrentOS as Filesystem-import qualified Options.Applicative as Options-import qualified Options.Applicative.Types as Options+import qualified Options.Applicative as Options+import qualified Options.Applicative.Types as Options+import qualified Options.Applicative.NonEmpty as Options.NonEmpty import qualified Text.Read #if MIN_VERSION_base(4,7,0)@@ -306,12 +396,20 @@ import Data.Singletons.TypeLits #endif +#if MIN_VERSION_base(4,8,0)+import Numeric.Natural (Natural)+#endif++#if MIN_VERSION_filepath(1,4,100)+import System.OsPath+#endif+ auto :: Read a => ReadM a auto = do s <- Options.readerAsk case Text.Read.readMaybe s of Just x -> return x- Nothing -> Options.readerAbort Options.ShowHelpText+ Nothing -> Options.readerAbort (Options.ShowHelpText Nothing) {-| A class for all record fields that can be parsed from exactly one option or argument on the command line@@ -327,26 +425,36 @@ -- ^ Help message -> Maybe Text -- ^ Field label+ -> Maybe Char+ -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser a default parseField- :: (Typeable a, Read a)- => Maybe Text+ :: Maybe Text -- ^ Help message -> Maybe Text -- ^ Field label+ -> Maybe Char+ -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser a- parseField h m = do- let metavar = map toUpper (show (Data.Typeable.typeOf (undefined :: a)))+ parseField h m c d = do+ let proxy = Proxy :: Proxy a case m of Nothing -> do- let fs = Options.metavar metavar- <> maybe mempty (Options.help . Data.Text.unpack) h- Options.argument auto fs+ let fs = Options.metavar (metavar proxy)+ <> foldMap (Options.help . Data.Text.unpack) h+ Options.argument readField fs Just name -> do- let fs = Options.metavar metavar+ let fs = Options.metavar (metavar proxy) <> Options.long (Data.Text.unpack name)- <> maybe mempty (Options.help . Data.Text.unpack) h- Options.option auto fs+ <> foldMap (Options.help . Data.Text.unpack) h+ <> foldMap Options.short c+ <> foldMap Options.value (d >>= runReadM readField)+ <> foldMap (Options.showDefaultWith . const) d+ Options.option readField fs {-| The only reason for this method is to provide a special case for handling `String`s. All other instances should just fall back on the@@ -357,98 +465,175 @@ -- ^ Help message -> Maybe Text -- ^ Field label+ -> Maybe Char+ -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser [a]- parseListOfField h m = many (parseField h m)+ parseListOfField h m c d = many (parseField h m c d) + readField :: ReadM a+ default readField :: Read a => ReadM a+ readField = auto++ metavar :: proxy a -> String+ default metavar :: Typeable a => proxy a -> String+ metavar _ = map toUpper (show (Data.Typeable.typeOf (undefined :: a)))++-- | a readMaybe using provided ReadM+runReadM :: ReadM a -> String -> Maybe a+runReadM r s = either (const Nothing) Just $+ runExcept (runReaderT (Options.unReadM r) s)+ instance ParseField Bool instance ParseField Double instance ParseField Float-instance ParseField Int instance ParseField Integer instance ParseField Ordering instance ParseField () instance ParseField Void +readIntegralBounded :: forall a. (Integral a, Bounded a, Typeable a, ParseField a) => ReadM a+readIntegralBounded =+ auto >>= f+ where+ f i | i < lower = fail msg+ | i > upper = fail msg+ | otherwise = pure $ fromInteger i+ lower = toInteger (minBound :: a)+ upper = toInteger (maxBound :: a)+ msg = metavar (Proxy :: Proxy a) <>+ " must be within the range [" <>+ show lower <> " .. " <> show upper <> "]"++instance ParseField Int where readField = readIntegralBounded+instance ParseField Int8 where readField = readIntegralBounded+instance ParseField Int16 where readField = readIntegralBounded+instance ParseField Int32 where readField = readIntegralBounded+instance ParseField Int64 where readField = readIntegralBounded+instance ParseField Word8 where readField = readIntegralBounded+instance ParseField Word16 where readField = readIntegralBounded+instance ParseField Word32 where readField = readIntegralBounded+instance ParseField Word64 where readField = readIntegralBounded++#if MIN_VERSION_base(4,8,0)+instance ParseField Natural where+ readField =+ auto >>= f+ where+ f i | i < 0 = fail msg+ | otherwise = pure $ fromInteger i+ msg = "NATURAL cannot be negative"+#endif+ instance ParseField String where parseField = parseHelpfulString "STRING" instance ParseField Char where- parseField h m = do- let metavar = "CHAR"- let readM = do- s <- Options.readerAsk- case s of- [c] -> return c- _ -> Options.readerAbort Options.ShowHelpText- case m of- Nothing -> do- let fs = Options.metavar metavar- <> maybe mempty (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- Options.option readM fs+ metavar _ = "CHAR"+ readField = do+ s <- Options.readerAsk+ case s of+ [ch] -> return ch+ _ -> Options.readerAbort (Options.ShowHelpText Nothing) parseListOfField = parseHelpfulString "STRING" instance ParseField Any where- parseField h m = Any <$> parseField h m+ metavar _ = "ANY"+ parseField h m c d = Any <$> parseField h m c d instance ParseField All where- parseField h m = All <$> parseField h m+ metavar _ = "ALL"+ parseField h m c d = All <$> parseField h m c d -parseHelpfulString :: String -> Maybe Text -> Maybe Text -> Parser String-parseHelpfulString metavar h m =+parseHelpfulString+ :: String -> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser String+parseHelpfulString metavar_ h m c d = case m of Nothing -> do- let fs = Options.metavar metavar- <> maybe mempty (Options.help . Data.Text.unpack) h+ let fs = Options.metavar metavar_+ <> foldMap (Options.help . Data.Text.unpack) h Options.argument Options.str fs Just name -> do- let fs = Options.metavar metavar+ 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+ <> foldMap ((Options.showDefault <>) . Options.value) d 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 d = Data.Text.pack <$> parseHelpfulString "TEXT" h m c d instance ParseField Data.ByteString.ByteString where- parseField h m = fmap Data.Text.Encoding.encodeUtf8 (parseField h m)+ parseField h m c d = fmap Data.Text.Encoding.encodeUtf8 (parseField h m c d) instance ParseField Data.Text.Lazy.Text where- parseField h m = Data.Text.Lazy.pack <$> parseHelpfulString "TEXT" h m+ parseField h m c d = Data.Text.Lazy.pack <$> parseHelpfulString "TEXT" h m c d instance ParseField Data.ByteString.Lazy.ByteString where- parseField h m = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m)+ parseField h m c d = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m c d) -instance ParseField FilePath where- parseField h m = Filesystem.decodeString <$> parseHelpfulString "FILEPATH" h m+readISO8601Field :: forall a . (ParseField a, ISO8601 a) => ReadM a+readISO8601Field = Options.eitherReader reader+ where+ reader string =+ case ISO8601.iso8601ParseM string of+ Nothing -> Left ("expected " <> metavar (Proxy :: Proxy a))+ Just t -> Right t -instance ParseField Data.Time.Calendar.Day where- parseField h m = do- let metavar = "YYYY-MM-DD"- case m of- Nothing -> do- let fs = Options.metavar metavar- <> maybe mempty (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- Options.option iso8601Day fs- where- iso8601Day = Options.eitherReader- $ runReadS . Data.Time.Format.readSTime- False- Data.Time.Format.defaultTimeLocale- "%F"+instance ParseField CalendarDiffDays where+ metavar _ = "PyYmMdD" - runReadS [(day, "")] = Right day- runReadS _ = Left "expected YYYY-MM-DD"+ readField = readISO8601Field +instance ParseField Day where+ metavar _ = "yyyy-mm-dd"++ readField = readISO8601Field++instance ParseField UTCTime where+ metavar _ = "yyyy-mm-ddThh:mm:ss[.sss]Z"++ readField = readISO8601Field++instance ParseField CalendarDiffTime where+ metavar _ = "PyYmMdDThHmMs[.sss]S"++ readField = readISO8601Field++instance ParseField TimeZone where+ metavar _ = "±hh:mm"++ readField = readISO8601Field++instance ParseField TimeOfDay where+ metavar _ = "hh:mm:ss[.sss]"++ readField = readISO8601Field++instance ParseField LocalTime where+ metavar _ = "yyyy-mm-ddThh:mm:ss[.sss]"++ readField = readISO8601Field++instance ParseField ZonedTime where+ metavar _ = "yyyy-mm-ddThh:mm:ss[.sss]±hh:mm"++ readField = readISO8601Field++#if MIN_VERSION_filepath(1,4,100)+instance ParseField OsString where+ metavar _ = "PATH"+ readField = Options.eitherReader reader+ where+ reader string =+ case encodeUtf string of+ Left err -> Left ("Invalid PATH: " ++ show err)+ Right t -> pure t++#endif+ {-| A class for all types that can be parsed from zero or more arguments/options on the command line @@ -461,65 +646,98 @@ -- ^ Help message -> Maybe Text -- ^ Field label+ -> Maybe Char+ -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser a- default parseFields :: ParseField a => Maybe Text -> Maybe Text -> Parser a+ default parseFields+ :: ParseField a => Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a parseFields = parseField instance ParseFields Char instance ParseFields Double instance ParseFields Float instance ParseFields Int+instance ParseFields Int8+instance ParseFields Int16+instance ParseFields Int32+instance ParseFields Int64 instance ParseFields Integer instance ParseFields Ordering instance ParseFields Void+instance ParseFields Word8+instance ParseFields Word16+instance ParseFields Word32+instance ParseFields Word64 instance ParseFields Data.ByteString.ByteString instance ParseFields Data.ByteString.Lazy.ByteString instance ParseFields Data.Text.Text instance ParseFields Data.Text.Lazy.Text-instance ParseFields FilePath-instance ParseFields Data.Time.Calendar.Day+instance ParseFields CalendarDiffDays+instance ParseFields Day+instance ParseFields UTCTime+instance ParseFields CalendarDiffTime+instance ParseFields TimeZone+instance ParseFields TimeOfDay+instance ParseFields LocalTime+instance ParseFields ZonedTime +#if MIN_VERSION_filepath(1,4,100)+instance ParseFields OsString+#endif++#if MIN_VERSION_base(4,8,0)+instance ParseFields Natural+#endif+ instance ParseFields Bool where- parseFields h m =+ parseFields h m c d = 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 $+ Just name -> case d >>= Text.Read.readMaybe of+ Nothing -> 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+ Just d0 -> Options.flag d0 (not d0) $+ Options.long (Data.Text.unpack name)+ <> 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 d = (fmap mconcat . many . fmap Any) (parseField h m c d) instance ParseFields All where- parseFields h m = (fmap mconcat . many . fmap All) (parseField h m)+ parseFields h m c d = (fmap mconcat . many . fmap All) (parseField h m c d) instance ParseField a => ParseFields (Maybe a) where- parseFields h m = optional (parseField h m)+ parseFields h m c d = optional (parseField h m c d) instance ParseField a => ParseFields (First a) where- parseFields h m = (fmap mconcat . many . fmap (First . Just)) (parseField h m)+ parseFields h m c d = (fmap mconcat . many . fmap (First . Just)) (parseField h m c d) instance ParseField a => ParseFields (Last a) where- parseFields h m = (fmap mconcat . many . fmap (Last . Just)) (parseField h m)+ parseFields h m c d = (fmap mconcat . many . fmap (Last . Just)) (parseField h m c d) instance (Num a, ParseField a) => ParseFields (Sum a) where- parseFields h m = (fmap mconcat . many . fmap Sum) (parseField h m)+ parseFields h m c d = (fmap mconcat . many . fmap Sum) (parseField h m c d) instance (Num a, ParseField a) => ParseFields (Product a) where- parseFields h m = (fmap mconcat . many . fmap Product) (parseField h m)+ parseFields h m c d = (fmap mconcat . many . fmap Product) (parseField h m c d) 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 d = Options.NonEmpty.some1 (parseField h m c d) {-| Use this to annotate a field with a type-level string (i.e. a `Symbol`) representing the help description for that field:@@ -529,21 +747,62 @@ > , bar :: Double <?> "Documentation for the bar flag" > } deriving (Generic, Show) -}-newtype (<?>) (field :: *) (help :: Symbol) = Helpful { unHelpful :: field } deriving (Generic, Show)+newtype (<?>) field (help :: Symbol) = Helpful { unHelpful :: field } deriving (Generic, Show, Data, Eq) 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 d = Helpful <$>+ parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c d+ readField = Helpful <$> readField+ metavar _ = metavar (Proxy :: Proxy a) 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 d = Helpful <$>+ parseFields ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c d instance (ParseFields a, KnownSymbol h) => ParseRecord (a <?> h) +{-| Use this to annotate a field with a type-level string (i.e. a `Symbol`)+ representing the default value for that field:++> data Example = Example+> { foo :: Int <!> "1"+> , bar :: Double <!> "0.5"+> } deriving (Generic, Show)+-}+newtype (<!>) field (value :: Symbol) = DefValue { unDefValue :: field } deriving (Generic, Show, Data, Eq)++instance (ParseField a, KnownSymbol d) => ParseField (a <!> d) where+ parseField h m c _ = DefValue <$> parseField h m c (Just (symbolVal (Proxy :: Proxy d)))+ readField = DefValue <$> readField+ metavar _ = metavar (Proxy :: Proxy a)++instance (ParseFields a, KnownSymbol d) => ParseFields (a <!> d) where+ parseFields h m c _ = DefValue <$> parseFields h m c (Just (symbolVal (Proxy :: Proxy d)))+instance (ParseFields a, KnownSymbol h) => ParseRecord (a <!> h)++{-| Use this to annotate a field with a type-level char (i.e. a `Symbol`)+ representing the short name of the field (only the first character of the+ symbol is used):++> data Example = Example+> { foo :: Int <#> "f"+> , bar :: Double <#> "b"+> } deriving (Generic, Show)+-}+newtype (<#>) field (value :: Symbol) = ShortName { unShortName :: field } deriving (Generic, Show, Data, Eq)++instance (ParseField a, KnownSymbol c) => ParseField (a <#> c) where+ parseField h m _ d = ShortName <$> parseField h m (listToMaybe (symbolVal (Proxy :: Proxy c))) d+ readField = ShortName <$> readField+ metavar _ = metavar (Proxy :: Proxy a)++instance (ParseFields a, KnownSymbol c) => ParseFields (a <#> c) where+ parseFields h m _ d = ShortName <$> parseFields h m (listToMaybe (symbolVal (Proxy :: Proxy c))) d+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 +831,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@@ -582,10 +845,31 @@ parseRecord = fmap getOnly parseRecord instance ParseRecord Int where parseRecord = fmap getOnly parseRecord+instance ParseRecord Int8 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Int16 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Int32 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Int64 where+ parseRecord = fmap getOnly parseRecord instance ParseRecord Ordering instance ParseRecord Void+instance ParseRecord Word8 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Word16 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Word32 where+ parseRecord = fmap getOnly parseRecord+instance ParseRecord Word64 where+ parseRecord = fmap getOnly parseRecord instance ParseRecord () +#if MIN_VERSION_base(4,8,0)+instance ParseRecord Natural where+ parseRecord = fmap getOnly parseRecord+#endif+ instance ParseRecord Bool where parseRecord = fmap getOnly parseRecord @@ -604,18 +888,41 @@ instance ParseRecord All where parseRecord = fmap getOnly parseRecord -instance ParseRecord FilePath where- parseRecord = fmap getOnly parseRecord- instance ParseRecord Data.ByteString.ByteString where parseRecord = fmap getOnly parseRecord instance ParseRecord Data.ByteString.Lazy.ByteString where parseRecord = fmap getOnly parseRecord -instance ParseRecord Data.Time.Calendar.Day where+instance ParseRecord CalendarDiffDays where parseRecord = fmap getOnly parseRecord +instance ParseRecord Day where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord UTCTime where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord CalendarDiffTime where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord TimeZone where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord TimeOfDay where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord LocalTime where+ parseRecord = fmap getOnly parseRecord++instance ParseRecord ZonedTime where+ parseRecord = fmap getOnly parseRecord++#if MIN_VERSION_filepath(1,4,100)+instance ParseRecord OsString where+ parseRecord = fmap getOnly parseRecord+#endif+ instance ParseField a => ParseRecord (Maybe a) where parseRecord = fmap getOnly parseRecord @@ -646,13 +953,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 +1012,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 +1113,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 Nothing) {- [NOTE - Sums] @@ -831,22 +1187,85 @@ 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)- info = Options.info parseRecord header +-- | 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 command 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 = getWithHelpWith desc mempty++-- | Marshal any value that implements `ParseRecord` from the command line+-- alongside an io action that prints the help message.+getWithHelpWith+ :: (MonadIO io, ParseRecord a)+ => Text+ -- ^ Program description+ -> Options.PrefsMod+ -- ^ 'ParserPrefs' modifiers+ -> io (a, io ())+ -- ^ (options, io action to print help message)+getWithHelpWith desc prefsMods = do+ a <- getRecordWith header prefsMods+ return (a, help)+ where+ header = Options.header (Data.Text.unpack desc)+ 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,23 +1279,53 @@ => [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 type instance Wrapped ::: wrapped = wrapped-type instance Unwrapped ::: (field <?> helper) = field+type instance Unwrapped ::: wrapped = Unwrap wrapped +type family Unwrap ty where+ Unwrap (ty <?> helper) = Unwrap ty+ Unwrap (ty <!> defVal) = Unwrap ty+ Unwrap (ty <#> shrtNm) = Unwrap ty+ Unwrap ty = ty+ infixr 0 ::: -- | Flag to keep fields wrapped@@ -884,6 +1333,7 @@ -- | Flag to unwrap fields annotated using '(<?>)' data Unwrapped+ deriving (Data) -- | Constraint for types whose fields can be unwrapped type Unwrappable f = (Generic (f Wrapped), Generic (f Unwrapped), GenericUnwrappable (Rep (f Wrapped)) (Rep (f Unwrapped)))@@ -907,9 +1357,18 @@ instance GenericUnwrappable (K1 i c) (K1 i c) where genericUnwrap = id -instance GenericUnwrappable (K1 i (field <?> helper)) (K1 i field) where- genericUnwrap (K1 c) = K1 (unHelpful c)+instance GenericUnwrappable (K1 i field) (K1 i c)+ => GenericUnwrappable (K1 i (field <?> helper)) (K1 i c) where+ genericUnwrap (K1 c) = (genericUnwrap :: K1 i field p -> K1 i c p) (K1 (unHelpful c)) +instance GenericUnwrappable (K1 i field) (K1 i c)+ => GenericUnwrappable (K1 i (field <!> defVal)) (K1 i c) where+ genericUnwrap (K1 c) = (genericUnwrap :: K1 i field p -> K1 i c p) (K1 (unDefValue c))++instance GenericUnwrappable (K1 i field) (K1 i c)+ => GenericUnwrappable (K1 i (field <#> defVal)) (K1 i c) where+ genericUnwrap (K1 c) = (genericUnwrap :: K1 i field p -> K1 i c p) (K1 (unShortName c))+ -- | Unwrap the fields of a constructor unwrap :: forall f . Unwrappable f => f Wrapped -> f Unwrapped unwrap = to . genericUnwrap . from@@ -929,3 +1388,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 Nothing) 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)