optparse-generic 1.1.0 → 1.1.1
raw patch · 2 files changed
+73/−27 lines, 2 filesdep +th-desugar
Dependencies added: th-desugar
Files
- optparse-generic.cabal +4/−2
- src/Options/Generic.hs +69/−25
optparse-generic.cabal view
@@ -1,5 +1,5 @@ Name: optparse-generic-Version: 1.1.0+Version: 1.1.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -7,6 +7,7 @@ Copyright: 2016 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com+Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 Bug-Reports: https://github.com/Gabriel439/Haskell-Optparse-Generic-Library/issues Synopsis: Auto-generate a command-line parser for your datatype Description: This library auto-generates an @optparse-applicative@-compatible@@ -33,6 +34,7 @@ if impl(ghc < 7.8) Build-Depends: singletons >= 0.10.0 && < 1.0 ,- tagged >= 0.8.3 && < 0.9+ tagged >= 0.8.3 && < 0.9 ,+ th-desugar < 1.5.1 Exposed-Modules: Options.Generic GHC-Options: -Wall
src/Options/Generic.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} @@ -206,14 +207,18 @@ module Options.Generic ( -- * Parsers getRecord+ , getRecordPure , ParseRecord(..) , ParseFields(..) , ParseField(..) , Only(..) , getOnly+ , Modifiers(..)+ , parseRecordWithModifiers+ , defaultModifiers -- * Help- , (<?>)(..)+ , type (<?>)(..) -- * Re-exports , Generic@@ -520,7 +525,7 @@ class ParseRecord a where parseRecord :: Parser a default parseRecord :: (Generic a, GenericParseRecord (Rep a)) => Parser a- parseRecord = fmap GHC.Generics.to genericParseRecord+ parseRecord = fmap GHC.Generics.to (genericParseRecord defaultModifiers) instance ParseFields a => ParseRecord (Only a) @@ -593,30 +598,38 @@ instance (ParseFields a, ParseFields b) => ParseRecord (Either a b) +data Modifiers = Modifiers+ { fieldNameModifier :: String -> String+ , constructorNameModifier :: String -> String+ }++defaultModifiers :: Modifiers+defaultModifiers = Modifiers id (map toLower)+ class GenericParseRecord f where- genericParseRecord :: Parser (f p)+ genericParseRecord :: Modifiers -> Parser (f p) instance GenericParseRecord U1 where- genericParseRecord = pure U1+ genericParseRecord _ = pure U1 -- See: [NOTE - Sums] instance GenericParseRecord f => GenericParseRecord (M1 C c f) where- genericParseRecord = fmap M1 genericParseRecord+ genericParseRecord = fmap M1 . genericParseRecord -- See: [NOTE - Sums] instance (GenericParseRecord (f :+: g), GenericParseRecord (h :+: i)) => GenericParseRecord ((f :+: g) :+: (h :+: i)) where- genericParseRecord = do- fmap L1 genericParseRecord <|> fmap R1 genericParseRecord+ genericParseRecord mods = do+ fmap L1 (genericParseRecord mods) <|> fmap R1 (genericParseRecord mods) -- See: [NOTE - Sums] instance (Constructor c, GenericParseRecord f, GenericParseRecord (g :+: h)) => GenericParseRecord (M1 C c f :+: (g :+: h)) where- genericParseRecord = do+ genericParseRecord mods@Modifiers{..} = do let m :: M1 i c f a m = undefined - let name = map toLower (conName m)+ let name = constructorNameModifier (conName m) - let info = Options.info (Options.helper <*> genericParseRecord) mempty+ let info = Options.info (Options.helper <*> (genericParseRecord mods)) mempty let subparserFields = Options.command name info@@ -624,17 +637,17 @@ let parser = Options.subparser subparserFields - fmap (L1 . M1) parser <|> fmap R1 genericParseRecord+ fmap (L1 . M1) parser <|> fmap R1 (genericParseRecord mods) -- See: [NOTE - Sums] instance (Constructor c, GenericParseRecord (f :+: g), GenericParseRecord h) => GenericParseRecord ((f :+: g) :+: M1 C c h) where- genericParseRecord = do+ genericParseRecord mods@Modifiers{..} = do let m :: M1 i c h a m = undefined - let name = map toLower (conName m)+ let name = constructorNameModifier (conName m) - let info = Options.info (Options.helper <*> genericParseRecord) mempty+ let info = Options.info (Options.helper <*> (genericParseRecord mods)) mempty let subparserFields = Options.command name info@@ -642,21 +655,21 @@ let parser = Options.subparser subparserFields - fmap L1 genericParseRecord <|> fmap (R1 . M1) parser+ fmap L1 (genericParseRecord mods) <|> fmap (R1 . M1) parser -- See: [NOTE - Sums] instance (Constructor c1, Constructor c2, GenericParseRecord f1, GenericParseRecord f2) => GenericParseRecord (M1 C c1 f1 :+: M1 C c2 f2) where- genericParseRecord = do+ genericParseRecord mods@Modifiers{..} = do let m1 :: M1 i c1 f a m1 = undefined let m2 :: M1 i c2 g a m2 = undefined - let name1 = map toLower (conName m1)- let name2 = map toLower (conName m2)+ let name1 = constructorNameModifier (conName m1)+ let name2 = constructorNameModifier (conName m2) - let info1 = Options.info (Options.helper <*> genericParseRecord) mempty- let info2 = Options.info (Options.helper <*> genericParseRecord) mempty+ let info1 = Options.info (Options.helper <*> (genericParseRecord mods)) mempty+ let info2 = Options.info (Options.helper <*> (genericParseRecord mods)) mempty let subparserFields1 = Options.command name1 info1@@ -671,19 +684,19 @@ fmap (L1 . M1) parser1 <|> fmap (R1 . M1) parser2 instance (GenericParseRecord f, GenericParseRecord g) => GenericParseRecord (f :*: g) where- genericParseRecord = liftA2 (:*:) genericParseRecord genericParseRecord+ genericParseRecord mods = liftA2 (:*:) (genericParseRecord mods) (genericParseRecord mods) instance GenericParseRecord V1 where- genericParseRecord = empty+ genericParseRecord _ = empty instance (Selector s, ParseFields a) => GenericParseRecord (M1 S s (K1 i a)) where- genericParseRecord = do+ genericParseRecord Modifiers{..} = do let m :: M1 i s f a m = undefined let label = case (selName m) of "" -> Nothing- name -> Just (Data.Text.pack name)+ name -> Just (Data.Text.pack (fieldNameModifier name)) fmap (M1 . K1) (parseFields Nothing label) {- [NOTE - Sums]@@ -752,8 +765,11 @@ -} instance GenericParseRecord f => GenericParseRecord (M1 D c f) where- genericParseRecord = fmap M1 (Options.helper <*> genericParseRecord)+ genericParseRecord mods = fmap M1 (Options.helper <*> genericParseRecord mods) +parseRecordWithModifiers :: (Generic a, GenericParseRecord (Rep a)) => Modifiers -> Parser a+parseRecordWithModifiers mods = fmap GHC.Generics.to (genericParseRecord mods)+ -- | Marshal any value that implements `ParseRecord` from the command line getRecord :: (MonadIO io, ParseRecord a)@@ -765,3 +781,31 @@ header = Options.header (Data.Text.unpack desc) info = Options.info parseRecord header++{-| Pure version of `getRecord`++>>> :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 args = do+ let prefs = Options.ParserPrefs+ { prefMultiSuffix = ""+ , prefDisambiguate = False+ , prefShowHelpOnError = False+ , prefBacktrack = True+ , prefColumns = 80+ }+ let header = Options.header ""+ let info = Options.info parseRecord header+ let args' = map Data.Text.unpack args+ Options.getParseResult (Options.execParserPure prefs info args')