mirror of
https://github.com/Gabriella439/Haskell-Optparse-Generic-Library.git
synced 2024-11-22 12:13:29 +03:00
Removes constraints from parseField method default implementation. (#48)
The goal is to make it more convenient to reuse the parseField method by avoiding superfluous constraints on the default implementation. With readField, the Read constraint on parseField is not required by the default implementation any more. I found myself needing to make dummy Read instances in order to reuse the default implementation. The Typeable constraint is only used to derive the metavar within parseField. So I extracted metavar out as another type class method. A nice side effect of this is that now it's possible to customize the metavar and still reuse the default parseFields implementation.
This commit is contained in:
parent
7baa281d8d
commit
900fa2b596
@ -365,8 +365,7 @@ class ParseField a where
|
||||
-- ^ Short name
|
||||
-> Parser a
|
||||
default parseField
|
||||
:: (Typeable a, Read a)
|
||||
=> Maybe Text
|
||||
:: Maybe Text
|
||||
-- ^ Help message
|
||||
-> Maybe Text
|
||||
-- ^ Field label
|
||||
@ -374,14 +373,14 @@ class ParseField a where
|
||||
-- ^ Short name
|
||||
-> Parser a
|
||||
parseField h m c = do
|
||||
let metavar = map toUpper (show (Data.Typeable.typeOf (undefined :: a)))
|
||||
let proxy = Proxy :: Proxy a
|
||||
case m of
|
||||
Nothing -> do
|
||||
let fs = Options.metavar metavar
|
||||
let fs = Options.metavar (metavar proxy)
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
Options.argument readField fs
|
||||
Just name -> do
|
||||
let fs = Options.metavar metavar
|
||||
let fs = Options.metavar (metavar proxy)
|
||||
<> Options.long (Data.Text.unpack name)
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
<> foldMap Options.short c
|
||||
@ -405,6 +404,10 @@ class ParseField a where
|
||||
default readField :: Read a => ReadM a
|
||||
readField = auto
|
||||
|
||||
metavar :: proxy a -> String
|
||||
default metavar :: Typeable a => proxy a -> String
|
||||
metavar _ = map toUpper (show (Data.Typeable.typeOf (undefined :: a)))
|
||||
|
||||
instance ParseField Bool
|
||||
instance ParseField Double
|
||||
instance ParseField Float
|
||||
@ -450,30 +453,20 @@ instance ParseField String where
|
||||
parseField = parseHelpfulString "STRING"
|
||||
|
||||
instance ParseField Char where
|
||||
parseField h m c = do
|
||||
let metavar = "CHAR"
|
||||
let readM = do
|
||||
s <- Options.readerAsk
|
||||
case s of
|
||||
[ch] -> return ch
|
||||
_ -> Options.readerAbort Options.ShowHelpText
|
||||
case m of
|
||||
Nothing -> do
|
||||
let fs = Options.metavar metavar
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
Options.argument readM fs
|
||||
Just name -> do
|
||||
let fs = Options.metavar metavar
|
||||
<> Options.long (Data.Text.unpack name)
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
<> foldMap Options.short c
|
||||
Options.option readM fs
|
||||
metavar _ = "CHAR"
|
||||
readField = do
|
||||
s <- Options.readerAsk
|
||||
case s of
|
||||
[ch] -> return ch
|
||||
_ -> Options.readerAbort Options.ShowHelpText
|
||||
|
||||
parseListOfField = parseHelpfulString "STRING"
|
||||
|
||||
instance ParseField Any where
|
||||
metavar _ = "ANY"
|
||||
parseField h m c = Any <$> parseField h m c
|
||||
instance ParseField All where
|
||||
metavar _ = "ALL"
|
||||
parseField h m c = All <$> parseField h m c
|
||||
|
||||
parseHelpfulString
|
||||
@ -508,28 +501,15 @@ instance ParseField FilePath where
|
||||
readField = Options.str
|
||||
|
||||
instance ParseField Data.Time.Calendar.Day where
|
||||
parseField h m c = do
|
||||
let metavar = "YYYY-MM-DD"
|
||||
case m of
|
||||
Nothing -> do
|
||||
let fs = Options.metavar metavar
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
Options.argument iso8601Day fs
|
||||
Just name -> do
|
||||
let fs = Options.metavar metavar
|
||||
<> Options.long (Data.Text.unpack name)
|
||||
<> foldMap (Options.help . Data.Text.unpack) h
|
||||
<> foldMap Options.short c
|
||||
Options.option iso8601Day fs
|
||||
metavar _ = "YYYY-MM-DD"
|
||||
readField = Options.eitherReader
|
||||
$ runReadS . Data.Time.Format.readSTime
|
||||
False
|
||||
Data.Time.Format.defaultTimeLocale
|
||||
"%F"
|
||||
where
|
||||
iso8601Day = Options.eitherReader
|
||||
$ runReadS . Data.Time.Format.readSTime
|
||||
False
|
||||
Data.Time.Format.defaultTimeLocale
|
||||
"%F"
|
||||
|
||||
runReadS [(day, "")] = Right day
|
||||
runReadS _ = Left "expected YYYY-MM-DD"
|
||||
runReadS [(day, "")] = Right day
|
||||
runReadS _ = Left "expected YYYY-MM-DD"
|
||||
|
||||
{-| A class for all types that can be parsed from zero or more arguments/options
|
||||
on the command line
|
||||
@ -633,6 +613,7 @@ instance (ParseField a, KnownSymbol h) => ParseField (a <?> h) where
|
||||
parseField _ m c = Helpful <$>
|
||||
parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c
|
||||
readField = Helpful <$> readField
|
||||
metavar _ = metavar (Proxy :: Proxy a)
|
||||
|
||||
instance (ParseFields a, KnownSymbol h) => ParseFields (a <?> h) where
|
||||
parseFields _ m c = Helpful <$>
|
||||
|
8
stack.ghc.7.8.4.yaml
Normal file
8
stack.ghc.7.8.4.yaml
Normal file
@ -0,0 +1,8 @@
|
||||
resolver: lts-2.22
|
||||
extra-deps:
|
||||
- Only-0.1
|
||||
- optparse-applicative-0.14.0.0
|
||||
- fail-4.9.0.0
|
||||
- time-1.5.0.1
|
||||
nix:
|
||||
enable: true
|
Loading…
Reference in New Issue
Block a user