{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

-- | This library auto-generates command-line parsers for data types using
-- Haskell's built-in support for generic programming.  The best way to
-- understand how this library works is to walk through a few examples.
--
-- 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)
--
-- Named fields translate to flags which you can provide in any order:
--
-- > $ stack build optparse-generic
-- > $ stack runghc Example.hs -- --bar 2.5 --foo 1
-- > Example {foo = 1, bar = 2.5}
--
-- This also auto-generates @--help@ output:
--
-- > $ 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)
--
-- ... 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
-- >   --bar DOUBLE             Documentation for the bar flag
--
-- However, any fields you document will be wrapped in the `Helpful`
-- constructor:
--
-- > $ stack runghc Example.hs -- --foo 1 --bar 2.5
-- > Example {foo = Helpful {unHelpful = 1}, bar = Helpful {unHelpful = 2.5}}
--
-- To avoid this, while still being able to document your fields, you may
-- 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)
--
-- @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.
--
-- This library will also do the right thing if the fields have no labels:
--
-- > data Example = Example Int Double deriving (Generic, Show)
--
-- Fields without labels translate into positional command-line arguments:
--
-- > $ stack runghc Example.hs -- 1 2.5
-- > Example 1 2.5
--
-- Certain types of fields are given special treatment, such as in this
-- example:
--
-- > data Example = Example
-- >     { switch   :: Bool
-- >     , list     :: [Int]
-- >     , optional :: Maybe   Int
-- >     , first    :: First   Int
-- >     , last     :: Last    Int
-- >     , sum      :: Sum     Int
-- >     , product  :: Product Int
-- >     } deriving (Generic, Show)
--
-- This gives the following behavior:
--
-- > $ stack runghc Example.hs --
-- >       --switch
-- >       --optional 1
-- >       --list    1 --list    2
-- >       --first   1 --first   2
-- >       --last    1 --last    2
-- >       --sum     1 --sum     2
-- >       --product 1 --product 2
-- > 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
-- > = 0}, product = Product {getProduct = 1}}
--
-- If a datatype has multiple constructors:
--
-- > data Example
-- >     = Create { name :: Text, duration :: Maybe Int }
-- >     | Kill   { name :: Text }
-- >     deriving (Generic, Show)
--
-- ... then they will translate into subcommands named after each constructor:
--
-- > $ stack runghc Example.hs -- create --name foo --duration=60
-- > Create {name = "foo", duration = Just 60}
-- > $ stack runghc Example.hs -- kill --name foo
-- > Kill {name = "foo"}
--
-- 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)
--
-- > $ 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))
--
-- > $ 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)
--
-- > $ stack runghc Example.hs -- 2
-- > 2
--
-- However, there are some types that this library cannot generate sensible
-- command-line parsers for, such as:
--
-- * recursive types:
--
--     > data Example = Example { foo :: Example }
--
-- * records whose fields are other records
--
--     > data Outer = Outer { foo :: Inner } deriving (Show, Generic)
--     > data Inner = Inner { bar :: Int   } deriving (Show, Generic)
--
-- * record fields  with nested `Maybe`s or nested lists
--
--     > data Example = Example { foo :: Maybe (Maybe Int) }
--     > data Example = Example { foo :: [[Int]]           }
--
-- If you try to auto-generate a parser for these types you will get an error at
-- compile time that will look something like this:
--
-- >     No instance for (ParseFields TheTypeOfYourField)
-- >       arising from a use of ‘Options.Generic.$gdmparseRecord’
-- >     In the expression: Options.Generic.$gdmparseRecord
-- >     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
    , 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
    , Unwrappable

    -- * Re-exports
    , Generic
    , Text
    , All(..)
    , Any(..)
    , First(..)
    , Last(..)
    , Sum(..)
    , Product(..)
    ) where

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.Int (Int8, Int16, Int32, Int64)
import Data.Maybe (listToMaybe)
import Data.Monoid
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.Word (Word8, Word16, Word32, Word64)
import Data.Foldable (foldMap)
import Filesystem.Path (FilePath)
import GHC.Generics
import Prelude hiding (FilePath)
import Options.Applicative (Parser, ReadM)

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.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 Text.Read

#if MIN_VERSION_base(4,7,0)
import GHC.TypeLits
#else
import Data.Singletons.TypeLits
#endif

#if MIN_VERSION_base(4,8,0)
import Numeric.Natural (Natural)
#endif

auto :: Read a => ReadM a
auto :: ReadM a
auto = do
    String
s <- ReadM String
Options.readerAsk
    case String -> Maybe a
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
s of
        Just a
x  -> a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Maybe a
Nothing -> ParseError -> ReadM a
forall a. ParseError -> ReadM a
Options.readerAbort (Maybe String -> ParseError
Options.ShowHelpText Maybe String
forall a. Maybe a
Nothing)

{-| A class for all record fields that can be parsed from exactly one option or
    argument on the command line

    `parseField` has a default implementation for any type that implements
    `Read` and `Typeable`.  You can derive `Read` for many types and you can
    derive `Typeable` for any type if you enable the @DeriveDataTypeable@
    language extension
-}
class ParseField a where
    parseField
        :: Maybe Text
        -- ^ Help message
        -> Maybe Text
        -- ^ Field label
        -> Maybe Char
        -- ^ Short name
        -> Maybe String
        -- ^ Default value
        -> Parser a
    default parseField
        :: Maybe Text
        -- ^ Help message
        -> Maybe Text
        -- ^ Field label
        -> Maybe Char
        -- ^ Short name
        -> Maybe String
        -- ^ Default value
        -> Parser a
    parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = do
        let proxy :: Proxy a
proxy = Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a
        case Maybe Text
m of
            Maybe Text
Nothing   -> do
                let fs :: Mod ArgumentFields a
fs =  String -> Mod ArgumentFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar (Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar Proxy a
proxy)
                       Mod ArgumentFields a
-> Mod ArgumentFields a -> Mod ArgumentFields a
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod ArgumentFields a)
-> Maybe Text -> Mod ArgumentFields a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod ArgumentFields a
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod ArgumentFields a)
-> (Text -> String) -> Text -> Mod ArgumentFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                ReadM a -> Mod ArgumentFields a -> Parser a
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Options.argument ReadM a
forall a. ParseField a => ReadM a
readField Mod ArgumentFields a
fs
            Just Text
name -> do
                let fs :: Mod OptionFields a
fs =  String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar (Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar Proxy a
proxy)
                       Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.long (Text -> String
Data.Text.unpack Text
name)
                       Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod OptionFields a) -> Maybe Text -> Mod OptionFields a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod OptionFields a)
-> (Text -> String) -> Text -> Mod OptionFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                       Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> (Char -> Mod OptionFields a) -> Maybe Char -> Mod OptionFields a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Options.short Maybe Char
c
                       Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> (a -> Mod OptionFields a) -> Maybe a -> Mod OptionFields a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Mod OptionFields a
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.value (Maybe String
d Maybe String -> (String -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadM a -> String -> Maybe a
forall a. ReadM a -> String -> Maybe a
runReadM ReadM a
forall a. ParseField a => ReadM a
readField)
                       Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> (String -> Mod OptionFields a)
-> Maybe String -> Mod OptionFields a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> String) -> Mod OptionFields a
forall a (f :: * -> *). (a -> String) -> Mod f a
Options.showDefaultWith ((a -> String) -> Mod OptionFields a)
-> (String -> a -> String) -> String -> Mod OptionFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> String
forall a b. a -> b -> a
const) Maybe String
d
                ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
Options.option   ReadM a
forall a. ParseField a => ReadM a
readField Mod OptionFields a
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
        default implementation for `parseListOfField`
    -}
    parseListOfField
        :: Maybe Text
        -- ^ Help message
        -> Maybe Text
        -- ^ Field label
        -> Maybe Char
        -- ^ Short name
        -> Maybe String
        -- ^ Default value
        -> Parser [a]
    parseListOfField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

    readField :: ReadM a
    default readField :: Read a => ReadM a
    readField = ReadM a
forall a. Read a => ReadM a
auto

    metavar :: proxy a -> String
    default metavar :: Typeable a => proxy a -> String
    metavar proxy a
_ = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
Data.Typeable.typeOf (a
forall a. HasCallStack => a
undefined :: a)))

-- | a readMaybe using provided ReadM
runReadM :: ReadM a -> String -> Maybe a
runReadM :: ReadM a -> String -> Maybe a
runReadM ReadM a
r String
s = (ParseError -> Maybe a)
-> (a -> Maybe a) -> Either ParseError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> ParseError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either ParseError a -> Maybe a) -> Either ParseError a -> Maybe a
forall a b. (a -> b) -> a -> b
$
    Except ParseError a -> Either ParseError a
forall e a. Except e a -> Either e a
runExcept (ReaderT String (Except ParseError) a
-> String -> Except ParseError a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReadM a -> ReaderT String (Except ParseError) a
forall a. ReadM a -> ReaderT String (Except ParseError) a
Options.unReadM ReadM a
r) String
s)

instance ParseField Bool
instance ParseField Double
instance ParseField Float
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 :: ReadM a
readIntegralBounded =
    ReadM Integer
forall a. Read a => ReadM a
auto ReadM Integer -> (Integer -> ReadM a) -> ReadM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ReadM a
f
    where
        f :: Integer -> ReadM a
f Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
lower = String -> ReadM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
            | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
upper = String -> ReadM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
            | Bool
otherwise = a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ReadM a) -> a -> ReadM a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
        lower :: Integer
lower = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a)
        upper :: Integer
upper = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a)
        msg :: String
msg = Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
              String
" must be within the range [" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
              Integer -> String
forall a. Show a => a -> String
show Integer
lower String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" .. " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
upper String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"

instance ParseField Int    where readField :: ReadM Int
readField = ReadM Int
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Int8   where readField :: ReadM Int8
readField = ReadM Int8
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Int16  where readField :: ReadM Int16
readField = ReadM Int16
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Int32  where readField :: ReadM Int32
readField = ReadM Int32
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Int64  where readField :: ReadM Int64
readField = ReadM Int64
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Word8  where readField :: ReadM Word8
readField = ReadM Word8
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Word16 where readField :: ReadM Word16
readField = ReadM Word16
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Word32 where readField :: ReadM Word32
readField = ReadM Word32
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded
instance ParseField Word64 where readField :: ReadM Word64
readField = ReadM Word64
forall a.
(Integral a, Bounded a, Typeable a, ParseField a) =>
ReadM a
readIntegralBounded

#if MIN_VERSION_base(4,8,0)
instance ParseField Natural where
    readField :: ReadM Natural
readField =
        ReadM Integer
forall a. Read a => ReadM a
auto ReadM Integer -> (Integer -> ReadM Natural) -> ReadM Natural
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ReadM Natural
forall (m :: * -> *) a. (MonadFail m, Num a) => Integer -> m a
f
        where
            f :: Integer -> m a
f Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
                | Bool
otherwise = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
            msg :: String
msg = String
"NATURAL cannot be negative"
#endif

instance ParseField String where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser String
parseField = String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
"STRING"

instance ParseField Char where
    metavar :: proxy Char -> String
metavar proxy Char
_ = String
"CHAR"
    readField :: ReadM Char
readField = do
        String
s <- ReadM String
Options.readerAsk
        case String
s of
            [Char
ch] -> Char -> ReadM Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
ch
            String
_    -> ParseError -> ReadM Char
forall a. ParseError -> ReadM a
Options.readerAbort (Maybe String -> ParseError
Options.ShowHelpText Maybe String
forall a. Maybe a
Nothing)

    parseListOfField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser String
parseListOfField = String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
"STRING"

instance ParseField Any where
    metavar :: proxy Any -> String
metavar proxy Any
_ = String
"ANY"
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Any
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = Bool -> Any
Any (Bool -> Any) -> Parser Bool -> Parser Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Bool
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d
instance ParseField All where
    metavar :: proxy All -> String
metavar proxy All
_ = String
"ALL"
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser All
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = Bool -> All
All (Bool -> All) -> Parser Bool -> Parser All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Bool
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d

parseHelpfulString
    :: String -> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser String
parseHelpfulString :: String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
metavar Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d =
    case Maybe Text
m of
        Maybe Text
Nothing   -> do
            let fs :: Mod ArgumentFields String
fs =  String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
metavar
                   Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod ArgumentFields String)
-> Maybe Text -> Mod ArgumentFields String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod ArgumentFields String)
-> (Text -> String) -> Text -> Mod ArgumentFields String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
            ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Options.argument ReadM String
forall s. IsString s => ReadM s
Options.str Mod ArgumentFields String
fs
        Just Text
name -> do
            let fs :: Mod OptionFields String
fs =  String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
metavar
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.long (Text -> String
Data.Text.unpack Text
name)
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod OptionFields String)
-> Maybe Text -> Mod OptionFields String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod OptionFields String)
-> (Text -> String) -> Text -> Mod OptionFields String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> (Char -> Mod OptionFields String)
-> Maybe Char -> Mod OptionFields String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Options.short Maybe Char
c
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> (String -> Mod OptionFields String)
-> Maybe String -> Mod OptionFields String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Options.showDefault Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>) (Mod OptionFields String -> Mod OptionFields String)
-> (String -> Mod OptionFields String)
-> String
-> Mod OptionFields String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.value) Maybe String
d
            ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
Options.option ReadM String
forall s. IsString s => ReadM s
Options.str Mod OptionFields String
fs

instance ParseField Data.Text.Text where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Text
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = String -> Text
Data.Text.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
"TEXT" Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d

instance ParseField Data.ByteString.ByteString where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser ByteString
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
Data.Text.Encoding.encodeUtf8 (Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Text
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField Data.Text.Lazy.Text where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Text
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = String -> Text
Data.Text.Lazy.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
"TEXT" Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d

instance ParseField Data.ByteString.Lazy.ByteString where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser ByteString
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
Data.Text.Lazy.Encoding.encodeUtf8 (Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Text
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField FilePath where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser FilePath
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = String -> FilePath
Filesystem.decodeString (String -> FilePath) -> Parser String -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe String
-> Parser String
parseHelpfulString String
"FILEPATH" Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d
    readField :: ReadM FilePath
readField = ReadM FilePath
forall s. IsString s => ReadM s
Options.str

instance ParseField Data.Time.Calendar.Day where
    metavar :: proxy Day -> String
metavar proxy Day
_ = String
"YYYY-MM-DD"
    readField :: ReadM Day
readField = (String -> Either String Day) -> ReadM Day
forall a. (String -> Either String a) -> ReadM a
Options.eitherReader
              ((String -> Either String Day) -> ReadM Day)
-> (String -> Either String Day) -> ReadM Day
forall a b. (a -> b) -> a -> b
$ [(Day, String)] -> Either String Day
forall b. [(b, String)] -> Either String b
runReadS ([(Day, String)] -> Either String Day)
-> (String -> [(Day, String)]) -> String -> Either String Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> [(Day, String)]
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
Data.Time.Format.readSTime
                            Bool
False
                            TimeLocale
Data.Time.Format.defaultTimeLocale
                            String
"%F"
        where
            runReadS :: [(b, String)] -> Either String b
runReadS [(b
day, String
"")] = b -> Either String b
forall a b. b -> Either a b
Right b
day
            runReadS [(b, String)]
_           = String -> Either String b
forall a b. a -> Either a b
Left String
"expected YYYY-MM-DD"

{-| A class for all types that can be parsed from zero or more arguments/options
    on the command line

    `parseFields` has a default implementation for any type that implements
    `ParseField`
-}
class ParseRecord a => ParseFields a where
    parseFields
        :: Maybe Text
        -- ^ Help message
        -> Maybe Text
        -- ^ Field label
        -> Maybe Char
        -- ^ Short name
        -> Maybe String
        -- ^ Default value
        -> Parser a
    default parseFields
        :: ParseField a => Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
    parseFields = Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
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

#if MIN_VERSION_base(4,8,0)
instance ParseFields Natural
#endif

instance ParseFields Bool where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Bool
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d =
        case Maybe Text
m of
            Maybe Text
Nothing   -> do
                let fs :: Mod ArgumentFields Bool
fs =  String -> Mod ArgumentFields Bool
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
"BOOL"
                       Mod ArgumentFields Bool
-> Mod ArgumentFields Bool -> Mod ArgumentFields Bool
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod ArgumentFields Bool)
-> Maybe Text -> Mod ArgumentFields Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod ArgumentFields Bool
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod ArgumentFields Bool)
-> (Text -> String) -> Text -> Mod ArgumentFields Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                ReadM Bool -> Mod ArgumentFields Bool -> Parser Bool
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Options.argument ReadM Bool
forall a. Read a => ReadM a
auto Mod ArgumentFields Bool
fs
            Just Text
name -> case Maybe String
d Maybe String -> (String -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Bool
forall a. Read a => String -> Maybe a
Text.Read.readMaybe of
                Maybe Bool
Nothing -> Mod FlagFields Bool -> Parser Bool
Options.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
                  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.long (Text -> String
Data.Text.unpack Text
name)
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod FlagFields Bool) -> Maybe Text -> Mod FlagFields Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod FlagFields Bool)
-> (Text -> String) -> Text -> Mod FlagFields Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> (Char -> Mod FlagFields Bool) -> Maybe Char -> Mod FlagFields Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Options.short Maybe Char
c
                Just Bool
d0 -> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
Options.flag Bool
d0 (Bool -> Bool
not Bool
d0) (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
                  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.long (Text -> String
Data.Text.unpack Text
name)
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> (Text -> Mod FlagFields Bool) -> Maybe Text -> Mod FlagFields Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Options.help (String -> Mod FlagFields Bool)
-> (Text -> String) -> Text -> Mod FlagFields Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Maybe Text
h
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> (Char -> Mod FlagFields Bool) -> Maybe Char -> Mod FlagFields Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Options.short Maybe Char
c
                 

instance ParseFields () where
    parseFields :: Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser ()
parseFields Maybe Text
_ Maybe Text
_ Maybe Char
_ Maybe String
_ = () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance ParseFields Any where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Any
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([Any] -> Any) -> Parser [Any] -> Parser Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Any] -> Any
forall a. Monoid a => [a] -> a
mconcat (Parser [Any] -> Parser Any)
-> (Parser Bool -> Parser [Any]) -> Parser Bool -> Parser Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Any -> Parser [Any]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Any -> Parser [Any])
-> (Parser Bool -> Parser Any) -> Parser Bool -> Parser [Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Any) -> Parser Bool -> Parser Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
Any) (Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Bool
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseFields All where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser All
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([All] -> All) -> Parser [All] -> Parser All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [All] -> All
forall a. Monoid a => [a] -> a
mconcat (Parser [All] -> Parser All)
-> (Parser Bool -> Parser [All]) -> Parser Bool -> Parser All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser All -> Parser [All]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser All -> Parser [All])
-> (Parser Bool -> Parser All) -> Parser Bool -> Parser [All]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> All) -> Parser Bool -> Parser All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> All
All) (Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser Bool
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField a => ParseFields (Maybe a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (Maybe a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField a => ParseFields (First a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (First a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([First a] -> First a) -> Parser [First a] -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [First a] -> First a
forall a. Monoid a => [a] -> a
mconcat (Parser [First a] -> Parser (First a))
-> (Parser a -> Parser [First a]) -> Parser a -> Parser (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (First a) -> Parser [First a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (First a) -> Parser [First a])
-> (Parser a -> Parser (First a)) -> Parser a -> Parser [First a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> First a) -> Parser a -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)) (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField a => ParseFields (Last a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (Last a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([Last a] -> Last a) -> Parser [Last a] -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Last a] -> Last a
forall a. Monoid a => [a] -> a
mconcat (Parser [Last a] -> Parser (Last a))
-> (Parser a -> Parser [Last a]) -> Parser a -> Parser (Last a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Last a) -> Parser [Last a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (Last a) -> Parser [Last a])
-> (Parser a -> Parser (Last a)) -> Parser a -> Parser [Last a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Last a) -> Parser a -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> (a -> Maybe a) -> a -> Last a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)) (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance (Num a, ParseField a) => ParseFields (Sum a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (Sum a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([Sum a] -> Sum a) -> Parser [Sum a] -> Parser (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Sum a] -> Sum a
forall a. Monoid a => [a] -> a
mconcat (Parser [Sum a] -> Parser (Sum a))
-> (Parser a -> Parser [Sum a]) -> Parser a -> Parser (Sum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Sum a) -> Parser [Sum a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (Sum a) -> Parser [Sum a])
-> (Parser a -> Parser (Sum a)) -> Parser a -> Parser [Sum a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Sum a) -> Parser a -> Parser (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sum a
forall a. a -> Sum a
Sum) (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance (Num a, ParseField a) => ParseFields (Product a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (Product a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = (([Product a] -> Product a)
-> Parser [Product a] -> Parser (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Product a] -> Product a
forall a. Monoid a => [a] -> a
mconcat (Parser [Product a] -> Parser (Product a))
-> (Parser a -> Parser [Product a])
-> Parser a
-> Parser (Product a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Product a) -> Parser [Product a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (Product a) -> Parser [Product a])
-> (Parser a -> Parser (Product a))
-> Parser a
-> Parser [Product a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Product a) -> Parser a -> Parser (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Product a
forall a. a -> Product a
Product) (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d)

instance ParseField a => ParseFields [a] where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser [a]
parseFields = Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser [a]
forall a.
ParseField a =>
Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser [a]
parseListOfField

instance ParseField a => ParseFields (NonEmpty a) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (NonEmpty a)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> Parser a -> Parser ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d Parser ([a] -> NonEmpty a) -> Parser [a] -> Parser (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser [a]
forall a.
ParseField a =>
Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser [a]
parseListOfField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
d

{-| Use this to annotate a field with a type-level string (i.e. a `Symbol`)
    representing the help description for that field:

> data Example = Example
>     { foo :: Int    <?> "Documentation for the foo flag"
>     , bar :: Double <?> "Documentation for the bar flag"
>     } deriving (Generic, Show)
-}
newtype (<?>) (field :: *) (help :: Symbol) = Helpful { (field <?> help) -> field
unHelpful :: field } deriving ((forall x. (field <?> help) -> Rep (field <?> help) x)
-> (forall x. Rep (field <?> help) x -> field <?> help)
-> Generic (field <?> help)
forall x. Rep (field <?> help) x -> field <?> help
forall x. (field <?> help) -> Rep (field <?> help) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall field (help :: Symbol) x.
Rep (field <?> help) x -> field <?> help
forall field (help :: Symbol) x.
(field <?> help) -> Rep (field <?> help) x
$cto :: forall field (help :: Symbol) x.
Rep (field <?> help) x -> field <?> help
$cfrom :: forall field (help :: Symbol) x.
(field <?> help) -> Rep (field <?> help) x
Generic, Int -> (field <?> help) -> String -> String
[field <?> help] -> String -> String
(field <?> help) -> String
(Int -> (field <?> help) -> String -> String)
-> ((field <?> help) -> String)
-> ([field <?> help] -> String -> String)
-> Show (field <?> help)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall field (help :: Symbol).
Show field =>
Int -> (field <?> help) -> String -> String
forall field (help :: Symbol).
Show field =>
[field <?> help] -> String -> String
forall field (help :: Symbol).
Show field =>
(field <?> help) -> String
showList :: [field <?> help] -> String -> String
$cshowList :: forall field (help :: Symbol).
Show field =>
[field <?> help] -> String -> String
show :: (field <?> help) -> String
$cshow :: forall field (help :: Symbol).
Show field =>
(field <?> help) -> String
showsPrec :: Int -> (field <?> help) -> String -> String
$cshowsPrec :: forall field (help :: Symbol).
Show field =>
Int -> (field <?> help) -> String -> String
Show)

instance (ParseField a, KnownSymbol h) => ParseField (a <?> h) where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <?> h)
parseField Maybe Text
_ Maybe Text
m Maybe Char
c Maybe String
d = a -> a <?> h
forall field (help :: Symbol). field -> field <?> help
Helpful (a -> a <?> h) -> Parser a -> Parser (a <?> h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField ((Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Proxy h -> Text) -> Proxy h -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack (String -> Text) -> (Proxy h -> String) -> Proxy h -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Proxy h -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal) (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)) Maybe Text
m Maybe Char
c Maybe String
d
    readField :: ReadM (a <?> h)
readField = a -> a <?> h
forall field (help :: Symbol). field -> field <?> help
Helpful (a -> a <?> h) -> ReadM a -> ReadM (a <?> h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM a
forall a. ParseField a => ReadM a
readField
    metavar :: proxy (a <?> h) -> String
metavar proxy (a <?> h)
_ = Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (ParseFields a, KnownSymbol h) => ParseFields (a <?> h) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <?> h)
parseFields Maybe Text
_ Maybe Text
m Maybe Char
c Maybe String
d = a -> a <?> h
forall field (help :: Symbol). field -> field <?> help
Helpful (a -> a <?> h) -> Parser a -> Parser (a <?> h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseFields a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseFields ((Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Proxy h -> Text) -> Proxy h -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack (String -> Text) -> (Proxy h -> String) -> Proxy h -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Proxy h -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal) (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)) Maybe Text
m Maybe Char
c Maybe String
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 { (field <!> value) -> field
unDefValue :: field } deriving ((forall x. (field <!> value) -> Rep (field <!> value) x)
-> (forall x. Rep (field <!> value) x -> field <!> value)
-> Generic (field <!> value)
forall x. Rep (field <!> value) x -> field <!> value
forall x. (field <!> value) -> Rep (field <!> value) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall field (value :: Symbol) x.
Rep (field <!> value) x -> field <!> value
forall field (value :: Symbol) x.
(field <!> value) -> Rep (field <!> value) x
$cto :: forall field (value :: Symbol) x.
Rep (field <!> value) x -> field <!> value
$cfrom :: forall field (value :: Symbol) x.
(field <!> value) -> Rep (field <!> value) x
Generic, Int -> (field <!> value) -> String -> String
[field <!> value] -> String -> String
(field <!> value) -> String
(Int -> (field <!> value) -> String -> String)
-> ((field <!> value) -> String)
-> ([field <!> value] -> String -> String)
-> Show (field <!> value)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall field (value :: Symbol).
Show field =>
Int -> (field <!> value) -> String -> String
forall field (value :: Symbol).
Show field =>
[field <!> value] -> String -> String
forall field (value :: Symbol).
Show field =>
(field <!> value) -> String
showList :: [field <!> value] -> String -> String
$cshowList :: forall field (value :: Symbol).
Show field =>
[field <!> value] -> String -> String
show :: (field <!> value) -> String
$cshow :: forall field (value :: Symbol).
Show field =>
(field <!> value) -> String
showsPrec :: Int -> (field <!> value) -> String -> String
$cshowsPrec :: forall field (value :: Symbol).
Show field =>
Int -> (field <!> value) -> String -> String
Show)

instance (ParseField a, KnownSymbol d) => ParseField (a <!> d) where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <!> d)
parseField Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
_ = a -> a <!> d
forall field (value :: Symbol). field -> field <!> value
DefValue (a -> a <!> d) -> Parser a -> Parser (a <!> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m Maybe Char
c (String -> Maybe String
forall a. a -> Maybe a
Just (Proxy d -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)))
    readField :: ReadM (a <!> d)
readField = a -> a <!> d
forall field (value :: Symbol). field -> field <!> value
DefValue (a -> a <!> d) -> ReadM a -> ReadM (a <!> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM a
forall a. ParseField a => ReadM a
readField
    metavar :: proxy (a <!> d) -> String
metavar proxy (a <!> d)
_ = Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (ParseFields a, KnownSymbol d) => ParseFields (a <!> d) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <!> d)
parseFields Maybe Text
h Maybe Text
m Maybe Char
c Maybe String
_ = a -> a <!> d
forall field (value :: Symbol). field -> field <!> value
DefValue (a -> a <!> d) -> Parser a -> Parser (a <!> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseFields a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseFields Maybe Text
h Maybe Text
m Maybe Char
c (String -> Maybe String
forall a. a -> Maybe a
Just (Proxy d -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy d
forall k (t :: k). Proxy t
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 { (field <#> value) -> field
unShortName :: field } deriving ((forall x. (field <#> value) -> Rep (field <#> value) x)
-> (forall x. Rep (field <#> value) x -> field <#> value)
-> Generic (field <#> value)
forall x. Rep (field <#> value) x -> field <#> value
forall x. (field <#> value) -> Rep (field <#> value) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall field (value :: Symbol) x.
Rep (field <#> value) x -> field <#> value
forall field (value :: Symbol) x.
(field <#> value) -> Rep (field <#> value) x
$cto :: forall field (value :: Symbol) x.
Rep (field <#> value) x -> field <#> value
$cfrom :: forall field (value :: Symbol) x.
(field <#> value) -> Rep (field <#> value) x
Generic, Int -> (field <#> value) -> String -> String
[field <#> value] -> String -> String
(field <#> value) -> String
(Int -> (field <#> value) -> String -> String)
-> ((field <#> value) -> String)
-> ([field <#> value] -> String -> String)
-> Show (field <#> value)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall field (value :: Symbol).
Show field =>
Int -> (field <#> value) -> String -> String
forall field (value :: Symbol).
Show field =>
[field <#> value] -> String -> String
forall field (value :: Symbol).
Show field =>
(field <#> value) -> String
showList :: [field <#> value] -> String -> String
$cshowList :: forall field (value :: Symbol).
Show field =>
[field <#> value] -> String -> String
show :: (field <#> value) -> String
$cshow :: forall field (value :: Symbol).
Show field =>
(field <#> value) -> String
showsPrec :: Int -> (field <#> value) -> String -> String
$cshowsPrec :: forall field (value :: Symbol).
Show field =>
Int -> (field <#> value) -> String -> String
Show)

instance (ParseField a, KnownSymbol c) => ParseField (a <#> c) where
    parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <#> c)
parseField Maybe Text
h Maybe Text
m Maybe Char
_ Maybe String
d = a -> a <#> c
forall field (value :: Symbol). field -> field <#> value
ShortName (a -> a <#> c) -> Parser a -> Parser (a <#> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseField a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseField Maybe Text
h Maybe Text
m (String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe (Proxy c -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))) Maybe String
d
    readField :: ReadM (a <#> c)
readField = a -> a <#> c
forall field (value :: Symbol). field -> field <#> value
ShortName (a -> a <#> c) -> ReadM a -> ReadM (a <#> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM a
forall a. ParseField a => ReadM a
readField
    metavar :: proxy (a <#> c) -> String
metavar proxy (a <#> c)
_ = Proxy a -> String
forall a (proxy :: * -> *). ParseField a => proxy a -> String
metavar (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (ParseFields a, KnownSymbol c) => ParseFields (a <#> c) where
    parseFields :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe String -> Parser (a <#> c)
parseFields Maybe Text
h Maybe Text
m Maybe Char
_ Maybe String
d = a -> a <#> c
forall field (value :: Symbol). field -> field <#> value
ShortName (a -> a <#> c) -> Parser a -> Parser (a <#> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseFields a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseFields Maybe Text
h Maybe Text
m (String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe (Proxy c -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))) Maybe String
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 ((forall x. Only_ a -> Rep (Only_ a) x)
-> (forall x. Rep (Only_ a) x -> Only_ a) -> Generic (Only_ a)
forall x. Rep (Only_ a) x -> Only_ a
forall x. Only_ a -> Rep (Only_ a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Only_ a) x -> Only_ a
forall a x. Only_ a -> Rep (Only_ a) x
$cto :: forall a x. Rep (Only_ a) x -> Only_ a
$cfrom :: forall a x. Only_ a -> Rep (Only_ a) x
Generic, Int -> Only_ a -> String -> String
[Only_ a] -> String -> String
Only_ a -> String
(Int -> Only_ a -> String -> String)
-> (Only_ a -> String)
-> ([Only_ a] -> String -> String)
-> Show (Only_ a)
forall a. Show a => Int -> Only_ a -> String -> String
forall a. Show a => [Only_ a] -> String -> String
forall a. Show a => Only_ a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Only_ a] -> String -> String
$cshowList :: forall a. Show a => [Only_ a] -> String -> String
show :: Only_ a -> String
$cshow :: forall a. Show a => Only_ a -> String
showsPrec :: Int -> Only_ a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Only_ a -> String -> String
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
    the same type:

> instance ParseRecord MyType where
>     parseRecord = fmap getOnly parseRecord
-}
getOnly :: Only a -> a
getOnly :: Only a -> a
getOnly (Only a
x) = a
x

{-| A class for types that can be parsed from the command line

    This class has a default implementation for any type that implements
    `Generic` and you can derive `Generic` for many types by enabling the
    @DeriveGeneric@ language extension

    You can also use `getOnly` to create a `ParseRecord` instance from a
    `ParseFields` instance:

> instance ParseRecord MyType where
>     parseRecord = fmap getOnly parseRecord
-}
class ParseRecord a where
    parseRecord :: Parser a
    default parseRecord :: (Generic a, GenericParseRecord (Rep a)) => Parser a
    parseRecord = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
GHC.Generics.to (Modifiers -> Parser (Rep a Any)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
defaultModifiers)

instance ParseFields a => ParseRecord (Only_ a)
instance ParseFields a => ParseRecord (Only a) where
    parseRecord :: Parser (Only a)
parseRecord = (Only_ a -> Only a) -> Parser (Only_ a) -> Parser (Only a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only_ a -> Only a
forall a. Only_ a -> Only a
adapt Parser (Only_ a)
forall a. ParseRecord a => Parser a
parseRecord
      where
        adapt :: Only_ a -> Only a
adapt (Only_ a
x) = a -> Only a
forall a. a -> Only a
Only a
x

instance ParseRecord Char where
    parseRecord :: Parser Char
parseRecord = (Only Char -> Char) -> Parser (Only Char) -> Parser Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Char -> Char
forall a. Only a -> a
getOnly Parser (Only Char)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Double where
    parseRecord :: Parser Double
parseRecord = (Only Double -> Double) -> Parser (Only Double) -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Double -> Double
forall a. Only a -> a
getOnly Parser (Only Double)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Float where
    parseRecord :: Parser Float
parseRecord = (Only Float -> Float) -> Parser (Only Float) -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Float -> Float
forall a. Only a -> a
getOnly Parser (Only Float)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Int where
    parseRecord :: Parser Int
parseRecord = (Only Int -> Int) -> Parser (Only Int) -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Int -> Int
forall a. Only a -> a
getOnly Parser (Only Int)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Int8 where
    parseRecord :: Parser Int8
parseRecord = (Only Int8 -> Int8) -> Parser (Only Int8) -> Parser Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Int8 -> Int8
forall a. Only a -> a
getOnly Parser (Only Int8)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Int16 where
    parseRecord :: Parser Int16
parseRecord = (Only Int16 -> Int16) -> Parser (Only Int16) -> Parser Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Int16 -> Int16
forall a. Only a -> a
getOnly Parser (Only Int16)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Int32 where
    parseRecord :: Parser Int32
parseRecord = (Only Int32 -> Int32) -> Parser (Only Int32) -> Parser Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Int32 -> Int32
forall a. Only a -> a
getOnly Parser (Only Int32)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Int64 where
    parseRecord :: Parser Int64
parseRecord = (Only Int64 -> Int64) -> Parser (Only Int64) -> Parser Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Int64 -> Int64
forall a. Only a -> a
getOnly Parser (Only Int64)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Ordering
instance ParseRecord Void
instance ParseRecord Word8 where
    parseRecord :: Parser Word8
parseRecord = (Only Word8 -> Word8) -> Parser (Only Word8) -> Parser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Word8 -> Word8
forall a. Only a -> a
getOnly Parser (Only Word8)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Word16 where
    parseRecord :: Parser Word16
parseRecord = (Only Word16 -> Word16) -> Parser (Only Word16) -> Parser Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Word16 -> Word16
forall a. Only a -> a
getOnly Parser (Only Word16)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Word32 where
    parseRecord :: Parser Word32
parseRecord = (Only Word32 -> Word32) -> Parser (Only Word32) -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Word32 -> Word32
forall a. Only a -> a
getOnly Parser (Only Word32)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord Word64 where
    parseRecord :: Parser Word64
parseRecord = (Only Word64 -> Word64) -> Parser (Only Word64) -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Word64 -> Word64
forall a. Only a -> a
getOnly Parser (Only Word64)
forall a. ParseRecord a => Parser a
parseRecord
instance ParseRecord ()

#if MIN_VERSION_base(4,8,0)
instance ParseRecord Natural where
    parseRecord :: Parser Natural
parseRecord = (Only Natural -> Natural)
-> Parser (Only Natural) -> Parser Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Natural -> Natural
forall a. Only a -> a
getOnly Parser (Only Natural)
forall a. ParseRecord a => Parser a
parseRecord
#endif

instance ParseRecord Bool where
    parseRecord :: Parser Bool
parseRecord = (Only Bool -> Bool) -> Parser (Only Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Bool -> Bool
forall a. Only a -> a
getOnly Parser (Only Bool)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Integer where
    parseRecord :: Parser Integer
parseRecord = (Only Integer -> Integer)
-> Parser (Only Integer) -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Integer -> Integer
forall a. Only a -> a
getOnly Parser (Only Integer)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Data.Text.Text where
    parseRecord :: Parser Text
parseRecord = (Only Text -> Text) -> Parser (Only Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Text -> Text
forall a. Only a -> a
getOnly Parser (Only Text)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Data.Text.Lazy.Text where
    parseRecord :: Parser Text
parseRecord = (Only Text -> Text) -> Parser (Only Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Text -> Text
forall a. Only a -> a
getOnly Parser (Only Text)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Any where
    parseRecord :: Parser Any
parseRecord = (Only Any -> Any) -> Parser (Only Any) -> Parser Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Any -> Any
forall a. Only a -> a
getOnly Parser (Only Any)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord All where
    parseRecord :: Parser All
parseRecord = (Only All -> All) -> Parser (Only All) -> Parser All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only All -> All
forall a. Only a -> a
getOnly Parser (Only All)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord FilePath where
    parseRecord :: Parser FilePath
parseRecord = (Only FilePath -> FilePath)
-> Parser (Only FilePath) -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only FilePath -> FilePath
forall a. Only a -> a
getOnly Parser (Only FilePath)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Data.ByteString.ByteString where
    parseRecord :: Parser ByteString
parseRecord = (Only ByteString -> ByteString)
-> Parser (Only ByteString) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only ByteString -> ByteString
forall a. Only a -> a
getOnly Parser (Only ByteString)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Data.ByteString.Lazy.ByteString where
    parseRecord :: Parser ByteString
parseRecord = (Only ByteString -> ByteString)
-> Parser (Only ByteString) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only ByteString -> ByteString
forall a. Only a -> a
getOnly Parser (Only ByteString)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseRecord Data.Time.Calendar.Day where
    parseRecord :: Parser Day
parseRecord = (Only Day -> Day) -> Parser (Only Day) -> Parser Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only Day -> Day
forall a. Only a -> a
getOnly Parser (Only Day)
forall a. ParseRecord a => Parser a
parseRecord

instance ParseField a => ParseRecord (Maybe a) where
    parseRecord :: Parser (Maybe a)
parseRecord = (Only (Maybe a) -> Maybe a)
-> Parser (Only (Maybe a)) -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (Maybe a) -> Maybe a
forall a. Only a -> a
getOnly Parser (Only (Maybe a))
forall a. ParseRecord a => Parser a
parseRecord

instance ParseField a => ParseRecord (First a) where
    parseRecord :: Parser (First a)
parseRecord = (Only (First a) -> First a)
-> Parser (Only (First a)) -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (First a) -> First a
forall a. Only a -> a
getOnly Parser (Only (First a))
forall a. ParseRecord a => Parser a
parseRecord

instance ParseField a => ParseRecord (Last a) where
    parseRecord :: Parser (Last a)
parseRecord = (Only (Last a) -> Last a)
-> Parser (Only (Last a)) -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (Last a) -> Last a
forall a. Only a -> a
getOnly Parser (Only (Last a))
forall a. ParseRecord a => Parser a
parseRecord

instance (Num a, ParseField a) => ParseRecord (Sum a) where
    parseRecord :: Parser (Sum a)
parseRecord = (Only (Sum a) -> Sum a) -> Parser (Only (Sum a)) -> Parser (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (Sum a) -> Sum a
forall a. Only a -> a
getOnly Parser (Only (Sum a))
forall a. ParseRecord a => Parser a
parseRecord

instance (Num a, ParseField a) => ParseRecord (Product a) where
    parseRecord :: Parser (Product a)
parseRecord = (Only (Product a) -> Product a)
-> Parser (Only (Product a)) -> Parser (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (Product a) -> Product a
forall a. Only a -> a
getOnly Parser (Only (Product a))
forall a. ParseRecord a => Parser a
parseRecord

instance ParseField a => ParseRecord [a] where
    parseRecord :: Parser [a]
parseRecord = (Only [a] -> [a]) -> Parser (Only [a]) -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only [a] -> [a]
forall a. Only a -> a
getOnly Parser (Only [a])
forall a. ParseRecord a => Parser a
parseRecord

instance ParseField a => ParseRecord (NonEmpty a) where
    parseRecord :: Parser (NonEmpty a)
parseRecord = (Only (NonEmpty a) -> NonEmpty a)
-> Parser (Only (NonEmpty a)) -> Parser (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only (NonEmpty a) -> NonEmpty a
forall a. Only a -> a
getOnly Parser (Only (NonEmpty a))
forall a. ParseRecord a => Parser a
parseRecord

instance (ParseFields a, ParseFields b) => ParseRecord (a, b)
instance (ParseFields a, ParseFields b, ParseFields c) => ParseRecord (a, b, c)
instance (ParseFields a, ParseFields b, ParseFields c, ParseFields d) => ParseRecord (a, b, c, d)
instance (ParseFields a, ParseFields b, ParseFields c, ParseFields d, ParseFields e) => ParseRecord (a, b, c, d, e)
instance (ParseFields a, ParseFields b, ParseFields c, ParseFields d, ParseFields e, ParseFields f) => ParseRecord (a, b, c, d, e, f)
instance (ParseFields a, ParseFields b, ParseFields c, ParseFields d, ParseFields e, ParseFields f, ParseFields g) => ParseRecord (a, b, c, d, e, f, g)

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
  { Modifiers -> String -> String
fieldNameModifier :: String -> String
  -- ^ Transform the name of derived fields (Default: @id@)
  , Modifiers -> String -> String
constructorNameModifier :: String -> String
  -- ^ Transform the name of derived constructors (Default: @map toLower@)
  , Modifiers -> String -> Maybe Char
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
defaultModifiers = Modifiers :: (String -> String)
-> (String -> String) -> (String -> Maybe Char) -> Modifiers
Modifiers
    { fieldNameModifier :: String -> String
fieldNameModifier       = String -> String
forall a. a -> a
id
    , constructorNameModifier :: String -> String
constructorNameModifier = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    , shortNameModifier :: String -> Maybe Char
shortNameModifier       = \String
_ -> Maybe Char
forall a. Maybe a
Nothing
    }

-- | Convert field and constructor names from @CamelCase@ to @lisp-case@.
--
-- Leading underscores are dropped, allowing one to use option names
-- which are Haskell keywords or otherwise conflicting identifiers.
--
-- > BuildCommand -> build-command
-- > someFlag -> --some-flag
-- > _type -> --type
-- > _splitAt -> --split-at
lispCaseModifiers :: Modifiers
lispCaseModifiers :: Modifiers
lispCaseModifiers = (String -> String)
-> (String -> String) -> (String -> Maybe Char) -> Modifiers
Modifiers String -> String
lispCase String -> String
lispCase (\String
_ -> Maybe Char
forall a. Maybe a
Nothing)
  where
    lispCase :: String -> String
lispCase = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Char -> String) -> String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> String
lower) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
    lower :: Char -> String
lower Char
c | Char -> Bool
isUpper Char
c = [Char
'-', Char -> Char
toLower Char
c]
            | Bool
otherwise = [Char
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 :: String -> Maybe Char
firstLetter (Char
c:String
_) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
firstLetter  String
_    = Maybe Char
forall a. Maybe a
Nothing

class GenericParseRecord f where
    genericParseRecord :: Modifiers -> Parser (f p)

instance GenericParseRecord U1 where
    genericParseRecord :: Modifiers -> Parser (U1 p)
genericParseRecord Modifiers
_ = U1 p -> Parser (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1

-- See: [NOTE - Sums]
instance GenericParseRecord f => GenericParseRecord (M1 C c f) where
    genericParseRecord :: Modifiers -> Parser (M1 C c f p)
genericParseRecord = (f p -> M1 C c f p) -> Parser (f p) -> Parser (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (f p) -> Parser (M1 C c f p))
-> (Modifiers -> Parser (f p)) -> Modifiers -> Parser (M1 C c f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifiers -> Parser (f p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord

-- See: [NOTE - Sums]
instance (GenericParseRecord (f :+: g), GenericParseRecord (h :+: i)) => GenericParseRecord ((f :+: g) :+: (h :+: i)) where
    genericParseRecord :: Modifiers -> Parser ((:+:) (f :+: g) (h :+: i) p)
genericParseRecord Modifiers
mods = do
        ((:+:) f g p -> (:+:) (f :+: g) (h :+: i) p)
-> Parser ((:+:) f g p) -> Parser ((:+:) (f :+: g) (h :+: i) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) f g p -> (:+:) (f :+: g) (h :+: i) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Modifiers -> Parser ((:+:) f g p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods) Parser ((:+:) (f :+: g) (h :+: i) p)
-> Parser ((:+:) (f :+: g) (h :+: i) p)
-> Parser ((:+:) (f :+: g) (h :+: i) p)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:+:) h i p -> (:+:) (f :+: g) (h :+: i) p)
-> Parser ((:+:) h i p) -> Parser ((:+:) (f :+: g) (h :+: i) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) h i p -> (:+:) (f :+: g) (h :+: i) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Modifiers -> Parser ((:+:) h i p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)

-- See: [NOTE - Sums]
instance (Constructor c, GenericParseRecord f, GenericParseRecord (g :+: h)) => GenericParseRecord (M1 C c f :+: (g :+: h)) where
    genericParseRecord :: Modifiers -> Parser ((:+:) (M1 C c f) (g :+: h) p)
genericParseRecord mods :: Modifiers
mods@Modifiers{String -> String
String -> Maybe Char
shortNameModifier :: String -> Maybe Char
constructorNameModifier :: String -> String
fieldNameModifier :: String -> String
shortNameModifier :: Modifiers -> String -> Maybe Char
constructorNameModifier :: Modifiers -> String -> String
fieldNameModifier :: Modifiers -> String -> String
..} = do
        let m :: M1 i c f a
            m :: M1 i c f a
m = M1 i c f a
forall a. HasCallStack => a
undefined

        let name :: String
name = String -> String
constructorNameModifier (M1 Any c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c f Any
forall i a. M1 i c f a
m)

        let info :: ParserInfo (f p)
info = Parser (f p) -> InfoMod (f p) -> ParserInfo (f p)
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info (Parser (f p -> f p)
forall a. Parser (a -> a)
Options.helper Parser (f p -> f p) -> Parser (f p) -> Parser (f p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Modifiers -> Parser (f p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)) InfoMod (f p)
forall a. Monoid a => a
mempty

        let subparserFields :: Mod CommandFields (f p)
subparserFields =
                   String -> ParserInfo (f p) -> Mod CommandFields (f p)
forall a. String -> ParserInfo a -> Mod CommandFields a
Options.command String
name ParserInfo (f p)
info
                Mod CommandFields (f p)
-> Mod CommandFields (f p) -> Mod CommandFields (f p)
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields (f p)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
name

        let parser :: Parser (f p)
parser = Mod CommandFields (f p) -> Parser (f p)
forall a. Mod CommandFields a -> Parser a
Options.subparser Mod CommandFields (f p)
subparserFields

        (f p -> (:+:) (M1 C c f) (g :+: h) p)
-> Parser (f p) -> Parser ((:+:) (M1 C c f) (g :+: h) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c f p -> (:+:) (M1 C c f) (g :+: h) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (M1 C c f p -> (:+:) (M1 C c f) (g :+: h) p)
-> (f p -> M1 C c f p) -> f p -> (:+:) (M1 C c f) (g :+: h) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) Parser (f p)
parser Parser ((:+:) (M1 C c f) (g :+: h) p)
-> Parser ((:+:) (M1 C c f) (g :+: h) p)
-> Parser ((:+:) (M1 C c f) (g :+: h) p)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:+:) g h p -> (:+:) (M1 C c f) (g :+: h) p)
-> Parser ((:+:) g h p) -> Parser ((:+:) (M1 C c f) (g :+: h) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) g h p -> (:+:) (M1 C c f) (g :+: h) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Modifiers -> Parser ((:+:) g h p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)

-- See: [NOTE - Sums]
instance (Constructor c, GenericParseRecord (f :+: g), GenericParseRecord h) => GenericParseRecord ((f :+: g) :+: M1 C c h) where
    genericParseRecord :: Modifiers -> Parser ((:+:) (f :+: g) (M1 C c h) p)
genericParseRecord mods :: Modifiers
mods@Modifiers{String -> String
String -> Maybe Char
shortNameModifier :: String -> Maybe Char
constructorNameModifier :: String -> String
fieldNameModifier :: String -> String
shortNameModifier :: Modifiers -> String -> Maybe Char
constructorNameModifier :: Modifiers -> String -> String
fieldNameModifier :: Modifiers -> String -> String
..} = do
        let m :: M1 i c h a
            m :: M1 i c h a
m = M1 i c h a
forall a. HasCallStack => a
undefined

        let name :: String
name = String -> String
constructorNameModifier (M1 Any c h Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c h Any
forall i a. M1 i c h a
m)

        let info :: ParserInfo (h p)
info = Parser (h p) -> InfoMod (h p) -> ParserInfo (h p)
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info (Parser (h p -> h p)
forall a. Parser (a -> a)
Options.helper Parser (h p -> h p) -> Parser (h p) -> Parser (h p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Modifiers -> Parser (h p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)) InfoMod (h p)
forall a. Monoid a => a
mempty

        let subparserFields :: Mod CommandFields (h p)
subparserFields =
                   String -> ParserInfo (h p) -> Mod CommandFields (h p)
forall a. String -> ParserInfo a -> Mod CommandFields a
Options.command String
name ParserInfo (h p)
info
                Mod CommandFields (h p)
-> Mod CommandFields (h p) -> Mod CommandFields (h p)
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields (h p)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
name

        let parser :: Parser (h p)
parser = Mod CommandFields (h p) -> Parser (h p)
forall a. Mod CommandFields a -> Parser a
Options.subparser Mod CommandFields (h p)
subparserFields

        ((:+:) f g p -> (:+:) (f :+: g) (M1 C c h) p)
-> Parser ((:+:) f g p) -> Parser ((:+:) (f :+: g) (M1 C c h) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) f g p -> (:+:) (f :+: g) (M1 C c h) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Modifiers -> Parser ((:+:) f g p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods) Parser ((:+:) (f :+: g) (M1 C c h) p)
-> Parser ((:+:) (f :+: g) (M1 C c h) p)
-> Parser ((:+:) (f :+: g) (M1 C c h) p)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (h p -> (:+:) (f :+: g) (M1 C c h) p)
-> Parser (h p) -> Parser ((:+:) (f :+: g) (M1 C c h) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c h p -> (:+:) (f :+: g) (M1 C c h) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (M1 C c h p -> (:+:) (f :+: g) (M1 C c h) p)
-> (h p -> M1 C c h p) -> h p -> (:+:) (f :+: g) (M1 C c h) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h p -> M1 C c h p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) Parser (h p)
parser

-- See: [NOTE - Sums]
instance (Constructor c1, Constructor c2, GenericParseRecord f1, GenericParseRecord f2) => GenericParseRecord (M1 C c1 f1 :+: M1 C c2 f2) where
    genericParseRecord :: Modifiers -> Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
genericParseRecord mods :: Modifiers
mods@Modifiers{String -> String
String -> Maybe Char
shortNameModifier :: String -> Maybe Char
constructorNameModifier :: String -> String
fieldNameModifier :: String -> String
shortNameModifier :: Modifiers -> String -> Maybe Char
constructorNameModifier :: Modifiers -> String -> String
fieldNameModifier :: Modifiers -> String -> String
..} = do
        let m1 :: M1 i c1 f a
            m1 :: M1 i c1 f a
m1 = M1 i c1 f a
forall a. HasCallStack => a
undefined
        let m2 :: M1 i c2 g a
            m2 :: M1 i c2 g a
m2 = M1 i c2 g a
forall a. HasCallStack => a
undefined

        let name1 :: String
name1 = String -> String
constructorNameModifier (M1 Any c1 Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c1 Any Any
forall i (f :: * -> *) a. M1 i c1 f a
m1)
        let name2 :: String
name2 = String -> String
constructorNameModifier (M1 Any c2 Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c2 Any Any
forall i (g :: * -> *) a. M1 i c2 g a
m2)

        let info1 :: ParserInfo (f1 p)
info1 = Parser (f1 p) -> InfoMod (f1 p) -> ParserInfo (f1 p)
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info (Parser (f1 p -> f1 p)
forall a. Parser (a -> a)
Options.helper Parser (f1 p -> f1 p) -> Parser (f1 p) -> Parser (f1 p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Modifiers -> Parser (f1 p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)) InfoMod (f1 p)
forall a. Monoid a => a
mempty
        let info2 :: ParserInfo (f2 p)
info2 = Parser (f2 p) -> InfoMod (f2 p) -> ParserInfo (f2 p)
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info (Parser (f2 p -> f2 p)
forall a. Parser (a -> a)
Options.helper Parser (f2 p -> f2 p) -> Parser (f2 p) -> Parser (f2 p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Modifiers -> Parser (f2 p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)) InfoMod (f2 p)
forall a. Monoid a => a
mempty

        let subparserFields1 :: Mod CommandFields (f1 p)
subparserFields1 =
                   String -> ParserInfo (f1 p) -> Mod CommandFields (f1 p)
forall a. String -> ParserInfo a -> Mod CommandFields a
Options.command String
name1 ParserInfo (f1 p)
info1
                Mod CommandFields (f1 p)
-> Mod CommandFields (f1 p) -> Mod CommandFields (f1 p)
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields (f1 p)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
name1
        let subparserFields2 :: Mod CommandFields (f2 p)
subparserFields2 =
                   String -> ParserInfo (f2 p) -> Mod CommandFields (f2 p)
forall a. String -> ParserInfo a -> Mod CommandFields a
Options.command String
name2 ParserInfo (f2 p)
info2
                Mod CommandFields (f2 p)
-> Mod CommandFields (f2 p) -> Mod CommandFields (f2 p)
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields (f2 p)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar String
name2

        let parser1 :: Parser (f1 p)
parser1 = Mod CommandFields (f1 p) -> Parser (f1 p)
forall a. Mod CommandFields a -> Parser a
Options.subparser Mod CommandFields (f1 p)
subparserFields1
        let parser2 :: Parser (f2 p)
parser2 = Mod CommandFields (f2 p) -> Parser (f2 p)
forall a. Mod CommandFields a -> Parser a
Options.subparser Mod CommandFields (f2 p)
subparserFields2

        (f1 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> Parser (f1 p) -> Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c1 f1 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (M1 C c1 f1 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> (f1 p -> M1 C c1 f1 p)
-> f1 p
-> (:+:) (M1 C c1 f1) (M1 C c2 f2) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f1 p -> M1 C c1 f1 p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) Parser (f1 p)
parser1 Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (f2 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> Parser (f2 p) -> Parser ((:+:) (M1 C c1 f1) (M1 C c2 f2) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c2 f2 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (M1 C c2 f2 p -> (:+:) (M1 C c1 f1) (M1 C c2 f2) p)
-> (f2 p -> M1 C c2 f2 p)
-> f2 p
-> (:+:) (M1 C c1 f1) (M1 C c2 f2) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f2 p -> M1 C c2 f2 p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) Parser (f2 p)
parser2

instance (GenericParseRecord f, GenericParseRecord g) => GenericParseRecord (f :*: g) where
    genericParseRecord :: Modifiers -> Parser ((:*:) f g p)
genericParseRecord Modifiers
mods = (f p -> g p -> (:*:) f g p)
-> Parser (f p) -> Parser (g p) -> Parser ((:*:) f g p)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (Modifiers -> Parser (f p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods) (Modifiers -> Parser (g p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)

instance GenericParseRecord V1 where
    genericParseRecord :: Modifiers -> Parser (V1 p)
genericParseRecord Modifiers
_ = Parser (V1 p)
forall (f :: * -> *) a. Alternative f => f a
empty

instance (Selector s, ParseFields a) => GenericParseRecord (M1 S s (K1 i a)) where
    genericParseRecord :: Modifiers -> Parser (M1 S s (K1 i a) p)
genericParseRecord Modifiers{String -> String
String -> Maybe Char
shortNameModifier :: String -> Maybe Char
constructorNameModifier :: String -> String
fieldNameModifier :: String -> String
shortNameModifier :: Modifiers -> String -> Maybe Char
constructorNameModifier :: Modifiers -> String -> String
fieldNameModifier :: Modifiers -> String -> String
..} = do
        let m :: M1 i s f a
            m :: M1 i s f a
m = M1 i s f a
forall a. HasCallStack => a
undefined

        let label :: Maybe Text
label = case M1 i s Any a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 i s Any a
forall (f :: * -> *). M1 i s f a
m of
                String
""   -> Maybe Text
forall a. Maybe a
Nothing
                String
name -> Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Data.Text.pack (String -> String
fieldNameModifier String
name))
        let shortName :: Maybe Char
shortName = String -> Maybe Char
shortNameModifier (M1 i s Any a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 i s Any a
forall (f :: * -> *). M1 i s f a
m)
        (a -> M1 S s (K1 i a) p) -> Parser a -> Parser (M1 S s (K1 i a) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a p -> M1 S s (K1 i a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a p -> M1 S s (K1 i a) p)
-> (a -> K1 i a p) -> a -> M1 S s (K1 i a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1) (Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
forall a.
ParseFields a =>
Maybe Text -> Maybe Text -> Maybe Char -> Maybe String -> Parser a
parseFields Maybe Text
forall a. Maybe a
Nothing Maybe Text
label Maybe Char
shortName Maybe String
forall a. Maybe a
Nothing)

{- [NOTE - Sums]

   You might wonder why the `GenericParseRecord` instances for `(:+:)` are so
   complicated.  A much simpler approach would be something like this:

> instance (GenericParseRecord f, GenericParseRecord g) => GenericParseRecord (f :+: g) where
>     genericParseRecord = fmap L1 genericParseRecord <|> fmap R1 genericParseRecord
> 
> instance (Constructor c, GenericParseRecord f) => GenericParseRecord (M1 C c f) where
>     genericParseRecord = do
>         let m :: M1 i c f a
>             m = undefined
> 
>         let name = map toLower (conName m)
> 
>         let info = Options.info genericParseRecord mempty
> 
>         let subparserFields =
>                    Options.command n info
>                 <> Options.metavar n
> 
>         fmap M1 (Options.subparser subparserFields)

    The reason for the extra complication is so that datatypes with just one
    constructor don't have subcommands.  That way, if a user defines a data
    type like:

> data Example = Example { foo :: Double } deriving (Generic)
>
> instance ParseRecord Example

    .. then the command line will only read in the @--foo@ flag and won't
    expect a gratuitous @example@ subcommand:

> ./example --foo 2

    However, if a user defines a data type with two constructors then the
    subcommand support will kick in.

    Some other alternatives that I considered and rejected:

    * Alternative #1: Constructors prefixed with something like @Command_@ are
      turned into sub-commands named after the constructor with the prefix
      stripped.  If the prefix is not present then they don't get a subcommand.

        I rejected this approach for several reasons:

        * It's ugly
        * It's error-prone (consider the case: @data T = C1 Int | C2 Int@, which
          would never successfully parse @C2@).  Subcommands should be mandatory
          for types with multiple constructors
        * It doesn't work "out-of-the-box" for most types in the Haskell
          ecosystem which were not written with this library in mind

    * Alternative #2: Any constructor named some reserved name (like @Only@)
      would not generate a sub-command.

        I rejected this approach for a couple of reasons:

        * Too surprising.  The user would never know or guess about this
          behavior without reading the documentation.
        * Doesn't work "out-of-the-box" for single-constructor types in the
          Haskell ecosystem (like `(a, b)`, for example)
-}

instance GenericParseRecord f => GenericParseRecord (M1 D c f) where
    genericParseRecord :: Modifiers -> Parser (M1 D c f p)
genericParseRecord Modifiers
mods = (f p -> M1 D c f p) -> Parser (f p) -> Parser (M1 D c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> M1 D c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (f p -> f p)
forall a. Parser (a -> a)
Options.helper Parser (f p -> f p) -> Parser (f p) -> Parser (f p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Modifiers -> Parser (f p)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
mods)

{-| 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 :: Modifiers -> Parser a
parseRecordWithModifiers Modifiers
mods = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
GHC.Generics.to (Modifiers -> Parser (Rep a Any)
forall (f :: * -> *) p.
GenericParseRecord f =>
Modifiers -> Parser (f p)
genericParseRecord Modifiers
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 :: Text -> io a
getRecord Text
desc = InfoMod a -> PrefsMod -> io a
forall (io :: * -> *) a.
(MonadIO io, ParseRecord a) =>
InfoMod a -> PrefsMod -> io a
getRecordWith InfoMod a
header PrefsMod
forall a. Monoid a => a
mempty
  where
    header :: InfoMod a
header = String -> InfoMod a
forall a. String -> InfoMod a
Options.header (Text -> String
Data.Text.unpack Text
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 :: InfoMod a -> PrefsMod -> io a
getRecordWith InfoMod a
infoMods PrefsMod
prefsMods = IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ParserPrefs -> ParserInfo a -> IO a
forall a. ParserPrefs -> ParserInfo a -> IO a
Options.customExecParser ParserPrefs
prefs ParserInfo a
info)
  where
    prefs :: ParserPrefs
prefs  = PrefsMod -> ParserPrefs
Options.prefs (PrefsMod
defaultParserPrefs PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
prefsMods)
    info :: ParserInfo a
info   = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info Parser a
forall a. ParseRecord a => Parser a
parseRecord InfoMod a
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 :: Text -> io (a, io ())
getWithHelp Text
desc = do
  a
a <- InfoMod a -> PrefsMod -> io a
forall (io :: * -> *) a.
(MonadIO io, ParseRecord a) =>
InfoMod a -> PrefsMod -> io a
getRecordWith InfoMod a
header PrefsMod
forall a. Monoid a => a
mempty
  (a, io ()) -> io (a, io ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, io ()
help)
  where
    header :: InfoMod a
header = String -> InfoMod a
forall a. String -> InfoMod a
Options.header (Text -> String
Data.Text.unpack Text
desc)
    info :: ParserInfo a
info   = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info Parser a
forall a. ParseRecord a => Parser a
parseRecord InfoMod a
header
    help :: io ()
help   = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ParserPrefs -> ParserInfo a -> IO ()
forall a. ParserPrefs -> ParserInfo a -> IO ()
showHelpText (PrefsMod -> ParserPrefs
Options.prefs PrefsMod
defaultParserPrefs) ParserInfo a
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
>>> getRecordPure ["1", "2"] :: Maybe [Int]
Just [1,2]
>>> getRecordPure ["Foo"] :: Maybe Int
Nothing
-}
getRecordPure
    :: ParseRecord a
    => [Text]
    -- ^ Command-line arguments
    -> Maybe a
getRecordPure :: [Text] -> Maybe a
getRecordPure [Text]
args = [Text] -> InfoMod a -> PrefsMod -> Maybe a
forall a.
ParseRecord a =>
[Text] -> InfoMod a -> PrefsMod -> Maybe a
getRecordPureWith [Text]
args InfoMod a
forall a. Monoid a => a
mempty PrefsMod
forall a. Monoid a => a
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 :: [Text] -> InfoMod a -> PrefsMod -> Maybe a
getRecordPureWith [Text]
args InfoMod a
infoMod PrefsMod
prefsMod = do
    let header :: InfoMod a
header = String -> InfoMod a
forall a. String -> InfoMod a
Options.header String
""
    let info :: ParserInfo a
info   = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info Parser a
forall a. ParseRecord a => Parser a
parseRecord (InfoMod a
forall a. InfoMod a
header InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> InfoMod a
infoMod)
    let prefs :: ParserPrefs
prefs  = PrefsMod -> ParserPrefs
Options.prefs (PrefsMod
defaultParserPrefs PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
prefsMod)
    let args' :: [String]
args'  = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Data.Text.unpack [Text]
args
    ParserResult a -> Maybe a
forall a. ParserResult a -> Maybe a
Options.getParseResult (ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
Options.execParserPure ParserPrefs
prefs ParserInfo a
info [String]
args')

-- | @optparse-generic@'s flavor of options.
defaultParserPrefs :: Options.PrefsMod
defaultParserPrefs :: PrefsMod
defaultParserPrefs = String -> PrefsMod
Options.multiSuffix String
"..."

-- | A type family to extract fields wrapped using '(<?>)'
type family (:::) wrap wrapped
type instance Wrapped ::: wrapped = wrapped
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
data Wrapped

-- | Flag to unwrap fields annotated using '(<?>)'
data Unwrapped

-- | Constraint for types whose fields can be unwrapped
type Unwrappable f = (Generic (f Wrapped), Generic (f Unwrapped), GenericUnwrappable (Rep (f Wrapped)) (Rep (f Unwrapped)))

class GenericUnwrappable f f' where
  genericUnwrap :: f p -> f' p

instance GenericUnwrappable U1 U1 where
  genericUnwrap :: U1 p -> U1 p
genericUnwrap = U1 p -> U1 p
forall a. a -> a
id

instance GenericUnwrappable f f' => GenericUnwrappable (M1 i c f) (M1 i c f') where
  genericUnwrap :: M1 i c f p -> M1 i c f' p
genericUnwrap = f' p -> M1 i c f' p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f' p -> M1 i c f' p)
-> (M1 i c f p -> f' p) -> M1 i c f p -> M1 i c f' p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f p -> f' p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap (f p -> f' p) -> (M1 i c f p -> f p) -> M1 i c f p -> f' p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance (GenericUnwrappable f f', GenericUnwrappable g g') => GenericUnwrappable (f :+: g) (f' :+: g') where
  genericUnwrap :: (:+:) f g p -> (:+:) f' g' p
genericUnwrap (L1 f p
f) = f' p -> (:+:) f' g' p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f p -> f' p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap f p
f)
  genericUnwrap (R1 g p
g) = g' p -> (:+:) f' g' p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g p -> g' p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap g p
g)

instance (GenericUnwrappable f f', GenericUnwrappable g g') => GenericUnwrappable (f :*: g) (f' :*: g') where
  genericUnwrap :: (:*:) f g p -> (:*:) f' g' p
genericUnwrap (f p
f :*: g p
g) = f p -> f' p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap f p
f f' p -> g' p -> (:*:) f' g' p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p -> g' p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap g p
g

instance GenericUnwrappable (K1 i c) (K1 i c) where
  genericUnwrap :: K1 i c p -> K1 i c p
genericUnwrap = K1 i c p -> K1 i c p
forall a. a -> a
id

instance GenericUnwrappable (K1 i field) (K1 i c)
  => GenericUnwrappable (K1 i (field <?> helper)) (K1 i c) where
    genericUnwrap :: K1 i (field <?> helper) p -> K1 i c p
genericUnwrap (K1 field <?> helper
c) = (forall p. K1 i field p -> K1 i c p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap :: K1 i field p -> K1 i c p) (field -> K1 i field p
forall k i c (p :: k). c -> K1 i c p
K1 ((field <?> helper) -> field
forall field (help :: Symbol). (field <?> help) -> field
unHelpful field <?> helper
c))

instance GenericUnwrappable (K1 i field) (K1 i c)
  => GenericUnwrappable (K1 i (field <!> defVal)) (K1 i c) where
    genericUnwrap :: K1 i (field <!> defVal) p -> K1 i c p
genericUnwrap (K1 field <!> defVal
c) = (forall p. K1 i field p -> K1 i c p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap :: K1 i field p -> K1 i c p) (field -> K1 i field p
forall k i c (p :: k). c -> K1 i c p
K1 ((field <!> defVal) -> field
forall field (value :: Symbol). (field <!> value) -> field
unDefValue field <!> defVal
c))

instance GenericUnwrappable (K1 i field) (K1 i c)
  => GenericUnwrappable (K1 i (field <#> defVal)) (K1 i c) where
    genericUnwrap :: K1 i (field <#> defVal) p -> K1 i c p
genericUnwrap (K1 field <#> defVal
c) = (forall p. K1 i field p -> K1 i c p
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap :: K1 i field p -> K1 i c p) (field -> K1 i field p
forall k i c (p :: k). c -> K1 i c p
K1 ((field <#> defVal) -> field
forall field (value :: Symbol). (field <#> value) -> field
unShortName field <#> defVal
c))

-- | Unwrap the fields of a constructor
unwrap :: forall f . Unwrappable f => f Wrapped -> f Unwrapped
unwrap :: f Wrapped -> f Unwrapped
unwrap = Rep (f Unwrapped) Any -> f Unwrapped
forall a x. Generic a => Rep a x -> a
to (Rep (f Unwrapped) Any -> f Unwrapped)
-> (f Wrapped -> Rep (f Unwrapped) Any) -> f Wrapped -> f Unwrapped
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (f Wrapped) Any -> Rep (f Unwrapped) Any
forall (f :: * -> *) (f' :: * -> *) p.
GenericUnwrappable f f' =>
f p -> f' p
genericUnwrap (Rep (f Wrapped) Any -> Rep (f Unwrapped) Any)
-> (f Wrapped -> Rep (f Wrapped) Any)
-> f Wrapped
-> Rep (f Unwrapped) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Wrapped -> Rep (f Wrapped) Any
forall a x. Generic a => a -> Rep a x
from

-- | Marshal any value that implements 'ParseRecord' from the command line
-- and unwrap its fields
unwrapRecord
    :: (Functor io, MonadIO io, ParseRecord (f Wrapped), Unwrappable f)
    => Text
    -> io (f Unwrapped)
unwrapRecord :: Text -> io (f Unwrapped)
unwrapRecord = (f Wrapped -> f Unwrapped) -> io (f Wrapped) -> io (f Unwrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f Wrapped -> f Unwrapped
forall (f :: * -> *). Unwrappable f => f Wrapped -> f Unwrapped
unwrap (io (f Wrapped) -> io (f Unwrapped))
-> (Text -> io (f Wrapped)) -> Text -> io (f Unwrapped)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> io (f Wrapped)
forall (io :: * -> *) a.
(MonadIO io, ParseRecord a) =>
Text -> io a
getRecord

-- | Pure version of `unwrapRecord`
unwrapRecordPure
    :: (ParseRecord (f Wrapped), Unwrappable f)
    => [Text]
    -- ^ Command-line arguments
    -> Maybe (f Unwrapped)
unwrapRecordPure :: [Text] -> Maybe (f Unwrapped)
unwrapRecordPure = (f Wrapped -> f Unwrapped)
-> Maybe (f Wrapped) -> Maybe (f Unwrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f Wrapped -> f Unwrapped
forall (f :: * -> *). Unwrappable f => f Wrapped -> f Unwrapped
unwrap (Maybe (f Wrapped) -> Maybe (f Unwrapped))
-> ([Text] -> Maybe (f Wrapped)) -> [Text] -> Maybe (f Unwrapped)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (f Wrapped)
forall a. ParseRecord a => [Text] -> Maybe a
getRecordPure

showHelpText :: Options.ParserPrefs -> Options.ParserInfo a -> IO ()
showHelpText :: ParserPrefs -> ParserInfo a -> IO ()
showHelpText ParserPrefs
pprefs ParserInfo a
pinfo =
  ParserResult () -> IO ()
forall a. ParserResult a -> IO a
Options.handleParseResult (ParserResult () -> IO ())
-> (ParserFailure ParserHelp -> ParserResult ())
-> ParserFailure ParserHelp
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserFailure ParserHelp -> ParserResult ()
forall a. ParserFailure ParserHelp -> ParserResult a
Options.Failure (ParserFailure ParserHelp -> IO ())
-> ParserFailure ParserHelp -> IO ()
forall a b. (a -> b) -> a -> b
$
  ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
Options.parserFailure ParserPrefs
pprefs ParserInfo a
pinfo (Maybe String -> ParseError
Options.ShowHelpText Maybe String
forall a. Maybe a
Nothing) [Context]
forall a. Monoid a => a
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 :: Text -> io (f Unwrapped, io ())
unwrapWithHelp Text
desc = do
  (f Wrapped
opts, io ()
help) <- Text -> io (f Wrapped, io ())
forall (io :: * -> *) a.
(MonadIO io, ParseRecord a) =>
Text -> io (a, io ())
getWithHelp Text
desc
  (f Unwrapped, io ()) -> io (f Unwrapped, io ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f Wrapped -> f Unwrapped
forall (f :: * -> *). Unwrappable f => f Wrapped -> f Unwrapped
unwrap f Wrapped
opts, io ()
help)