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:
Sophia Rose 2018-02-22 10:19:28 -05:00 committed by Gabriel Gonzalez
parent 7baa281d8d
commit 900fa2b596
2 changed files with 33 additions and 44 deletions

View File

@ -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
metavar _ = "CHAR"
readField = 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
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,26 +501,13 @@ 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
where
iso8601Day = Options.eitherReader
metavar _ = "YYYY-MM-DD"
readField = Options.eitherReader
$ runReadS . Data.Time.Format.readSTime
False
Data.Time.Format.defaultTimeLocale
"%F"
where
runReadS [(day, "")] = Right day
runReadS _ = Left "expected YYYY-MM-DD"
@ -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
View 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