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.

src/Options/Generic.hs

@@ -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
+    metavar _ = "CHAR"
-        let metavar = "CHAR"
+    readField = do
-        let readM = do
+        s <- Options.readerAsk
-                s <- Options.readerAsk
+        case s of
-                case s of
+            [ch] -> return ch
-                    [ch] -> return ch
+            _    -> Options.readerAbort Options.ShowHelpText
-                    _    -> 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,28 +501,15 @@ instance ParseField FilePath where
     readField = Options.str
 
 instance ParseField Data.Time.Calendar.Day where
-    parseField h m c = do
+    metavar _ = "YYYY-MM-DD"
-        let metavar = "YYYY-MM-DD"
+    readField = Options.eitherReader
-        case m of
+              $ runReadS . Data.Time.Format.readSTime
-            Nothing   -> do
+                            False
-                let fs =  Options.metavar metavar
+                            Data.Time.Format.defaultTimeLocale
-                       <> foldMap (Options.help . Data.Text.unpack) h
+                            "%F"
-                Options.argument iso8601Day fs
-            Just name -> do
-                let fs =  Options.metavar metavar
-                       <> Options.long (Data.Text.unpack name)
-                       <> foldMap (Options.help . Data.Text.unpack) h
-                       <> foldMap Options.short c
-                Options.option   iso8601Day fs
         where
-        iso8601Day = Options.eitherReader
+            runReadS [(day, "")] = Right day
-                   $ runReadS . Data.Time.Format.readSTime
+            runReadS _           = Left "expected YYYY-MM-DD"
-                                  False
-                                  Data.Time.Format.defaultTimeLocale
-                                  "%F"
-
-        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 <$>

stack.ghc.7.8.4.yaml

@@ -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