optparse-generic 1.1.4 → 1.1.5
raw patch · 2 files changed
+126/−21 lines, 2 filesdep ~optparse-applicative
Dependency ranges changed: optparse-applicative
Files
- optparse-generic.cabal +2/−2
- src/Options/Generic.hs +124/−19
optparse-generic.cabal view
@@ -1,5 +1,5 @@ Name: optparse-generic-Version: 1.1.4+Version: 1.1.5 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -27,7 +27,7 @@ system-filepath >= 0.3.1 && < 0.5 , text < 1.3 , transformers >= 0.2.0.0 && < 0.6 ,- optparse-applicative >= 0.11.0 && < 0.14,+ optparse-applicative >= 0.12.0 && < 0.14, time >= 1.5 && < 1.7 , void < 0.8 , bytestring < 0.11,
src/Options/Generic.hs view
@@ -1,12 +1,16 @@+{-# 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@@ -86,6 +90,36 @@ -- > $ 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}+-- -- For the following examples I encourage you to test what @--help@ output they -- generate. --@@ -208,6 +242,8 @@ -- * Parsers getRecord , getRecordPure+ , unwrapRecord+ , unwrapRecordPure , ParseRecord(..) , ParseFields(..) , ParseField(..)@@ -216,9 +252,14 @@ , Modifiers(..) , parseRecordWithModifiers , defaultModifiers+ , lispCaseModifiers -- * Help , type (<?>)(..)+ , type (:::)+ , Wrapped+ , Unwrapped+ , Unwrappable -- * Re-exports , Generic@@ -233,7 +274,7 @@ import Control.Applicative import Control.Monad.IO.Class (MonadIO(..))-import Data.Char (toLower, toUpper)+import Data.Char (isUpper, toLower, toUpper) import Data.Monoid import Data.List.NonEmpty (NonEmpty((:|))) import Data.Proxy@@ -613,6 +654,22 @@ defaultModifiers :: Modifiers defaultModifiers = Modifiers id (map toLower) +-- | 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 lispCase lispCase+ where+ lispCase = dropWhile (== '-') . (>>= lower) . dropWhile (== '_')+ lower c | isUpper c = ['-', toLower c]+ | otherwise = [c]+ class GenericParseRecord f where genericParseRecord :: Modifiers -> Parser (f p) @@ -783,14 +840,9 @@ => Text -- ^ Program description -> io a-getRecord desc = liftIO (Options.customExecParser prefs info)+getRecord desc = liftIO (Options.customExecParser defaultParserPrefs info) where- prefs = Options.defaultPrefs- { Options.prefMultiSuffix = "..."- }- header = Options.header (Data.Text.unpack desc)- info = Options.info parseRecord header {-| Pure version of `getRecord`@@ -809,18 +861,71 @@ -- ^ Command-line arguments -> Maybe a getRecordPure args = do- let prefs = Options.ParserPrefs- { prefMultiSuffix = "..."- , prefDisambiguate = False- , prefShowHelpOnError = False- , prefBacktrack = True- , prefColumns = 80-#if MIN_VERSION_optparse_applicative(0,13,0)- , prefShowHelpOnEmpty = False-#else-#endif- } let header = Options.header "" let info = Options.info parseRecord header let args' = map Data.Text.unpack args- Options.getParseResult (Options.execParserPure prefs info args')+ Options.getParseResult (Options.execParserPure defaultParserPrefs info args')++-- | @optparse-generic@'s flavor of options.+defaultParserPrefs :: Options.ParserPrefs+defaultParserPrefs = Options.defaultPrefs+ { Options.prefMultiSuffix = "..."+ }++-- | A type family to extract fields wrapped using '(<?>)'+type family (:::) wrap wrapped+type instance Wrapped ::: wrapped = wrapped+type instance Unwrapped ::: (field <?> helper) = field++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 = id++instance GenericUnwrappable f f' => GenericUnwrappable (M1 i c f) (M1 i c f') where+ genericUnwrap = M1 . genericUnwrap . unM1++instance (GenericUnwrappable f f', GenericUnwrappable g g') => GenericUnwrappable (f :+: g) (f' :+: g') where+ genericUnwrap (L1 f) = L1 (genericUnwrap f)+ genericUnwrap (R1 g) = R1 (genericUnwrap g)++instance (GenericUnwrappable f f', GenericUnwrappable g g') => GenericUnwrappable (f :*: g) (f' :*: g') where+ genericUnwrap (f :*: g) = genericUnwrap f :*: genericUnwrap g++instance GenericUnwrappable (K1 i c) (K1 i c) where+ genericUnwrap = id++instance GenericUnwrappable (K1 i (field <?> helper)) (K1 i field) where+ genericUnwrap (K1 c) = K1 (unHelpful c)++-- | Unwrap the fields of a constructor+unwrap :: forall f . Unwrappable f => f Wrapped -> f Unwrapped+unwrap = to . genericUnwrap . 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 = fmap unwrap . getRecord++-- | Pure version of `unwrapRecord`+unwrapRecordPure+ :: (ParseRecord (f Wrapped), Unwrappable f)+ => [Text]+ -- ^ Command-line arguments+ -> Maybe (f Unwrapped)+unwrapRecordPure = fmap unwrap . getRecordPure