optparse-generic 1.2.3 → 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 +40/−16
- src/Options/Generic.hs +408/−197
+ 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.2.3-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,24 +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 ,+ 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.14.0.0 && < 0.15,- time >= 1.5 && < 1.9 ,+ optparse-applicative >= 0.16.0.0 && < 0.20,+ time >= 1.5 && < 1.15, void < 0.8 ,- bytestring < 0.11,- semigroups >= 0.5.0 && < 0.19+ 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 ,@@ -41,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@@ -239,49 +276,59 @@ -- > In the instance declaration for ‘ParseRecord TheTypeOfYourRecord’ -- -- You can customize the library's default behavior using the--- `parseRecordWithModifiers` utility, like this:+-- '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)+-- @+-- {-# 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@@ -300,34 +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 Data.Word (Word8, Word16, Word32, Word64)-import Data.Foldable (foldMap)-import Filesystem.Path (FilePath) 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)@@ -340,12 +400,16 @@ 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@@ -363,28 +427,33 @@ -- ^ 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 c = 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+ 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) <> 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@@ -398,13 +467,24 @@ -- ^ Field label -> Maybe Char -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser [a]- parseListOfField h m c = many (parseField h m c)+ 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@@ -413,7 +493,7 @@ instance ParseField () instance ParseField Void -readIntegralBounded :: forall a. (Integral a, Bounded a, Typeable a) => ReadM a+readIntegralBounded :: forall a. (Integral a, Bounded a, Typeable a, ParseField a) => ReadM a readIntegralBounded = auto >>= f where@@ -422,7 +502,7 @@ | otherwise = pure $ fromInteger i lower = toInteger (minBound :: a) upper = toInteger (maxBound :: a)- msg = map toUpper (show (Data.Typeable.typeOf (undefined :: a))) <>+ msg = metavar (Proxy :: Proxy a) <> " must be within the range [" <> show lower <> " .. " <> show upper <> "]" @@ -450,87 +530,110 @@ parseField = parseHelpfulString "STRING" instance ParseField Char where- parseField h m c = do- let metavar = "CHAR"- let readM = do- s <- Options.readerAsk- case s of- [ch] -> return ch- _ -> Options.readerAbort Options.ShowHelpText- case m of- Nothing -> do- let fs = Options.metavar metavar- <> 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)- <> foldMap (Options.help . Data.Text.unpack) h- <> foldMap Options.short c- 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 c = Any <$> parseField h m c+ metavar _ = "ANY"+ parseField h m c d = Any <$> parseField h m c d instance ParseField All where- parseField h m c = All <$> parseField h m c+ metavar _ = "ALL"+ parseField h m c d = All <$> parseField h m c d parseHelpfulString- :: String -> Maybe Text -> Maybe Text -> Maybe Char -> Parser String-parseHelpfulString metavar h m c =+ :: 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+ 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) <> 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 c = Data.Text.pack <$> parseHelpfulString "TEXT" h m c+ parseField h m c d = Data.Text.pack <$> parseHelpfulString "TEXT" h m c d instance ParseField Data.ByteString.ByteString where- parseField h m c = fmap Data.Text.Encoding.encodeUtf8 (parseField h m c)+ 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 c = Data.Text.Lazy.pack <$> parseHelpfulString "TEXT" h m c+ 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 c = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m c)+ parseField h m c d = fmap Data.Text.Lazy.Encoding.encodeUtf8 (parseField h m c d) -instance ParseField FilePath where- parseField h m c = Filesystem.decodeString <$> parseHelpfulString "FILEPATH" h m c- readField = Options.str+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 c = do- let metavar = "YYYY-MM-DD"- case m of- Nothing -> do- let fs = Options.metavar metavar- <> 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)- <> foldMap (Options.help . Data.Text.unpack) h- <> foldMap Options.short c- 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 @@ -545,9 +648,11 @@ -- ^ Field label -> Maybe Char -- ^ Short name+ -> Maybe String+ -- ^ Default value -> Parser a default parseFields- :: ParseField a => Maybe Text -> Maybe Text -> Maybe Char -> Parser a+ :: ParseField a => Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a parseFields = parseField instance ParseFields Char@@ -569,55 +674,70 @@ 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 c =+ parseFields h m c d = case m of Nothing -> do let fs = Options.metavar "BOOL" <> 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) <> 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 c = (fmap mconcat . many . fmap Any) (parseField h m c)+ parseFields h m c d = (fmap mconcat . many . fmap Any) (parseField h m c d) instance ParseFields All where- parseFields h m c = (fmap mconcat . many . fmap All) (parseField h m c)+ 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 c = optional (parseField h m c)+ parseFields h m c d = optional (parseField h m c d) instance ParseField a => ParseFields (First a) where- parseFields h m c = (fmap mconcat . many . fmap (First . Just)) (parseField h m c)+ 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 c = (fmap mconcat . many . fmap (Last . Just)) (parseField h m c)+ 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 c = (fmap mconcat . many . fmap Sum) (parseField h m c)+ 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 c = (fmap mconcat . many . fmap Product) (parseField h m c)+ 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 c = (:|) <$> parseField h m c <*> parseListOfField h m c+ 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:@@ -627,18 +747,58 @@ > , 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 c = Helpful <$>- parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c+ 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 c = Helpful <$>- parseFields ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c+ 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 -}@@ -728,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 @@ -934,7 +1117,7 @@ "" -> Nothing name -> Just (Data.Text.pack (fieldNameModifier name)) let shortName = shortNameModifier (selName m)- fmap (M1 . K1) (parseFields Nothing label shortName)+ fmap (M1 . K1) (parseFields Nothing label shortName Nothing) {- [NOTE - Sums] @@ -1050,7 +1233,7 @@ prefs = Options.prefs (defaultParserPrefs <> prefsMods) info = Options.info parseRecord infoMods --- | Marshal any value that implements `ParseRecord` from the commmand line+-- | Marshal any value that implements `ParseRecord` from the command line -- alongside an io action that prints the help message. getWithHelp :: (MonadIO io, ParseRecord a)@@ -1058,8 +1241,20 @@ -- ^ Program description -> io (a, io ()) -- ^ (options, io action to print help message)-getWithHelp desc = do- a <- getRecordWith header mempty+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)@@ -1123,8 +1318,14 @@ -- | 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@@ -1132,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)))@@ -1155,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@@ -1181,7 +1392,7 @@ showHelpText :: Options.ParserPrefs -> Options.ParserInfo a -> IO () showHelpText pprefs pinfo = Options.handleParseResult . Options.Failure $- Options.parserFailure pprefs pinfo Options.ShowHelpText mempty+ 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