optima 0.4.0.3 → 0.4.0.4
raw patch · 4 files changed
+260/−241 lines, 4 filesdep ~optparse-applicative
Dependency ranges changed: optparse-applicative
Files
- demo/Main.hs +55/−35
- library/Optima.hs +175/−170
- library/Optima/Prelude.hs +20/−26
- optima.cabal +10/−10
demo/Main.hs view
@@ -1,40 +1,60 @@ module Main where -import Prelude-import qualified Optima import qualified Attoparsec.Data as Attoparsec import qualified Data.Text as Text-+import qualified Optima+import Prelude -main = parseOpts >>= print where- parseOpts =- Optima.params "Demo"- (liftA3 (,,)- (Optima.param (Just 'a') "arg-a"- (Optima.value- "Description of A"- (Optima.showable True)- Optima.unformatted- (Optima.explicitlyParsed Attoparsec.bool)))- (Optima.group "group1"- (liftA2 (,)- (Optima.member "bb"- (Optima.value- "Description of B"- Optima.defaultless- Optima.unformatted- (Optima.explicitlyParsed Attoparsec.text)))- (Optima.member "d" textParam)))- (Optima.group "group-of-alternatives"- (asum [- Optima.member "e" textParam,- Optima.subgroup "subgroup" (asum [- Optima.member "f" textParam,- Optima.member "g" (flag $> "slkdfjsdkj"),- Text.concat <$> some (Optima.member "h" textParam)- ])- ])))- where- textParam = Optima.value "Text param" Optima.defaultless Optima.unformatted (Optima.explicitlyParsed Attoparsec.text)- flag = Optima.flag "Flag type 1"- bytesParam = Optima.value "" Optima.defaultless Optima.unformatted (Optima.explicitlyParsed Attoparsec.utf8Bytes)+main = parseOpts >>= print+ where+ parseOpts =+ Optima.params+ "Demo"+ ( liftA3+ (,,)+ ( Optima.param+ (Just 'a')+ "arg-a"+ ( Optima.value+ "Description of A"+ (Optima.showable True)+ Optima.unformatted+ (Optima.explicitlyParsed Attoparsec.bool)+ )+ )+ ( Optima.group+ "group1"+ ( liftA2+ (,)+ ( Optima.member+ "bb"+ ( Optima.value+ "Description of B"+ Optima.defaultless+ Optima.unformatted+ (Optima.explicitlyParsed Attoparsec.text)+ )+ )+ (Optima.member "d" textParam)+ )+ )+ ( Optima.group+ "group-of-alternatives"+ ( asum+ [ Optima.member "e" textParam,+ Optima.subgroup+ "subgroup"+ ( asum+ [ Optima.member "f" textParam,+ Optima.member "g" (flag $> "slkdfjsdkj"),+ Text.concat <$> some (Optima.member "h" textParam)+ ]+ )+ ]+ )+ )+ )+ where+ textParam = Optima.value "Text param" Optima.defaultless Optima.unformatted (Optima.explicitlyParsed Attoparsec.text)+ flag = Optima.flag "Flag type 1"+ bytesParam = Optima.value "" Optima.defaultless Optima.unformatted (Optima.explicitlyParsed Attoparsec.utf8Bytes)
library/Optima.hs view
@@ -1,304 +1,309 @@ module Optima-(- -- * IO- params,- -- * Params- Params,- param,- group,- -- * ParamGroup- ParamGroup,- member,- subgroup,- -- * Param- Param,- value,- flag,- -- * Value- Value,- explicitlyParsed,- implicitlyParsed,- -- * Default- Default,- explicitlyRepresented,- showable,- defaultless,- -- * ValueFormat- ValueFormat,- formattedByEnum,- formattedByEnumUsingShow,- unformatted,-)+ ( -- * IO+ params,++ -- * Params+ Params,+ param,+ group,++ -- * ParamGroup+ ParamGroup,+ member,+ subgroup,++ -- * Param+ Param,+ value,+ flag,++ -- * Value+ Value,+ explicitlyParsed,+ implicitlyParsed,++ -- * Default+ Default,+ explicitlyRepresented,+ showable,+ defaultless,++ -- * ValueFormat+ ValueFormat,+ formattedByEnum,+ formattedByEnumUsingShow,+ unformatted,+ ) where -import Optima.Prelude hiding (group)-import qualified Data.Text as Text+import qualified Attoparsec.Data as Attoparsec import qualified Data.Attoparsec.Text as Attoparsec+import qualified Data.Text as Text+import Optima.Prelude hiding (group) import qualified Options.Applicative as Optparse-import qualified Attoparsec.Data as Attoparsec import qualified Text.Builder as TextBuilder - -- * Types-------------------------- -{-|-Parameters product parser.-Should be used for composition of all application parameters.--}+-- |+-- Parameters product parser.+-- Should be used for composition of all application parameters. newtype Params a = Params (Optparse.Parser a) -{-|-Parameter parser.--Includes the description of the parameter.--}+-- |+-- Parameter parser.+--+-- Includes the description of the parameter. newtype Param a = Param (Maybe Char -> Text -> Optparse.Parser a) -{-|-Parameter group, which gets identified by prefixing the names.--Should be used to define parameters, which only make sense in combination.-E.g., a server config can be defined by providing port and host together.--}+-- |+-- Parameter group, which gets identified by prefixing the names.+--+-- Should be used to define parameters, which only make sense in combination.+-- E.g., a server config can be defined by providing port and host together. newtype ParamGroup a = ParamGroup (Text -> Optparse.Parser a) -{-|-Parameter value parser.--}+-- |+-- Parameter value parser. newtype Value a = Value (Attoparsec.Parser a) -{-|-Default value with its textual representation.--}+-- |+-- Default value with its textual representation. data Default a = SpecifiedDefault a Text | UnspecifiedDefault -{-|-Parameter description.--}+-- |+-- Parameter description. data ValueFormat a = EnumValueFormat [TextBuilder.Builder] | UnspecifiedFormat - -- * Instances-------------------------- deriving instance Functor Params+ deriving instance Applicative Params+ deriving instance Alternative Params deriving instance Functor ParamGroup+ instance Applicative ParamGroup where- pure x = ParamGroup (\ _ -> pure x)- (<*>) (ParamGroup left) (ParamGroup right) = ParamGroup (\ prefix -> left prefix <*> right prefix)+ pure x = ParamGroup (\_ -> pure x)+ (<*>) (ParamGroup left) (ParamGroup right) = ParamGroup (\prefix -> left prefix <*> right prefix)+ instance Alternative ParamGroup where- empty = ParamGroup (\ _ -> empty)- (<|>) (ParamGroup left) (ParamGroup right) = ParamGroup (\ prefix -> left prefix <|> right prefix)- many (ParamGroup parser) = ParamGroup (\ prefix -> many (parser prefix))- some (ParamGroup parser) = ParamGroup (\ prefix -> some (parser prefix))+ empty = ParamGroup (\_ -> empty)+ (<|>) (ParamGroup left) (ParamGroup right) = ParamGroup (\prefix -> left prefix <|> right prefix)+ many (ParamGroup parser) = ParamGroup (\prefix -> many (parser prefix))+ some (ParamGroup parser) = ParamGroup (\prefix -> some (parser prefix)) deriving instance Functor Param deriving instance Functor Value+ deriving instance Applicative Value+ deriving instance Alternative Value+ deriving instance Monad Value+ deriving instance MonadPlus Value+ deriving instance MonadFail Value deriving instance Functor Default deriving instance Functor ValueFormat - -- * Functions-------------------------- -- ** IO-------------------------- -{-|-Execute the parameters parser in IO,-throwing an exception if anything goes wrong.--}-params :: Text {-^ Description of the application -} -> Params a -> IO a+-- |+-- Execute the parameters parser in IO,+-- throwing an exception if anything goes wrong.+params ::+ -- | Description of the application+ Text ->+ Params a ->+ IO a params description (Params parser) = Optparse.execParser (Optparse.info (Optparse.helper <*> parser) mods) where mods = Optparse.fullDesc <> Optparse.progDesc (Text.unpack description) - -- ** Params-------------------------- -{-|-Lift a single parameter parser.--}-param :: Maybe Char {-^ Single-char name -} -> Text {-^ Long name -} -> Param a -> Params a+-- |+-- Lift a single parameter parser.+param ::+ -- | Single-char name+ Maybe Char ->+ -- | Long name+ Text ->+ Param a ->+ Params a param shortName longName (Param parser) = Params (parser shortName longName) -{-|-Lift a parameter group parser.--The param group cannot use short names, only long names.--}-group :: Text {-^ Prefix for the long names of the parameters. If empty, then there'll be no prefixing -} -> ParamGroup a -> Params a+-- |+-- Lift a parameter group parser.+--+-- The param group cannot use short names, only long names.+group ::+ -- | Prefix for the long names of the parameters. If empty, then there'll be no prefixing+ Text ->+ ParamGroup a ->+ Params a group prefix (ParamGroup parser) = Params (parser prefix) - -- ** ParamGroup-------------------------- -{-|-Lift a param parser into parameter group.--}-member :: Text {-^ Long name of the parameter -} -> Param a -> ParamGroup a-member name (Param parser) = ParamGroup (\ prefix -> parser Nothing (prefixIfMakesSense prefix name)) where--{-|-Unite a group by a shared prefix.--}-subgroup :: Text {-^ Long name prefix -} -> ParamGroup a -> ParamGroup a-subgroup prefix (ParamGroup parser) = ParamGroup (\ higherPrefix -> parser (prefixIfMakesSense higherPrefix prefix))+-- |+-- Lift a param parser into parameter group.+member ::+ -- | Long name of the parameter+ Text ->+ Param a ->+ ParamGroup a+member name (Param parser) = ParamGroup (\prefix -> parser Nothing (prefixIfMakesSense prefix name)) where +-- |+-- Unite a group by a shared prefix.+subgroup ::+ -- | Long name prefix+ Text ->+ ParamGroup a ->+ ParamGroup a+subgroup prefix (ParamGroup parser) = ParamGroup (\higherPrefix -> parser (prefixIfMakesSense higherPrefix prefix)) -- ** Param-------------------------- -{-|-Create a single parameter parser from a value parser and meta information.--}-value :: Text {-^ Description. Can be empty -} -> Default a {-^ Default value -} -> ValueFormat a {-^ Value format -} -> Value a -> Param a+-- |+-- Create a single parameter parser from a value parser and meta information.+value ::+ -- | Description. Can be empty+ Text ->+ -- | Default value+ Default a ->+ -- | Value format+ ValueFormat a ->+ Value a ->+ Param a value description def format (Value attoparsecParser) =- Param (\ shortName longName -> Optparse.option readM (mods shortName longName))+ Param (\shortName longName -> Optparse.option readM (mods shortName longName)) where readM = Optparse.eitherReader (Attoparsec.parseOnly attoparsecParser . Text.pack) mods shortName longName =- longParamName longName <>- foldMap Optparse.short shortName <>- paramHelp description format <>- defaultValue def+ longParamName longName+ <> foldMap Optparse.short shortName+ <> paramHelp description format+ <> defaultValue def -{-|-A parameter with no value. Fails if it's not present.-Thus it can be composed using Alternative.--}-flag :: Text {-^ Description. Can be empty -} -> Param ()+-- |+-- A parameter with no value. Fails if it's not present.+-- Thus it can be composed using Alternative.+flag ::+ -- | Description. Can be empty+ Text ->+ Param () flag description =- Param (\ shortName longName ->- Optparse.flag' ()- (longParamName longName <> foldMap Optparse.short shortName <> paramHelp description UnspecifiedFormat))-+ Param+ ( \shortName longName ->+ Optparse.flag'+ ()+ (longParamName longName <> foldMap Optparse.short shortName <> paramHelp description UnspecifiedFormat)+ ) -- ** Value-------------------------- -{-|-Lift an Attoparsec parser into value parser.--}+-- |+-- Lift an Attoparsec parser into value parser. explicitlyParsed :: Attoparsec.Parser a -> Value a explicitlyParsed = Value -{-|-Lift an implicit lenient Attoparsec parser into value parser.--}+-- |+-- Lift an implicit lenient Attoparsec parser into value parser. implicitlyParsed :: Attoparsec.LenientParser a => Value a implicitlyParsed = Value Attoparsec.lenientParser - -- ** Default-------------------------- -{-|-Provide a default value with explicit textual representation.--}+-- |+-- Provide a default value with explicit textual representation. explicitlyRepresented :: (a -> Text) -> a -> Default a explicitlyRepresented render value = SpecifiedDefault value (render value) -{-|-Provide a default value with textual representation formed using the implicit Show instance.--}+-- |+-- Provide a default value with textual representation formed using the implicit Show instance. showable :: Show a => a -> Default a showable a = SpecifiedDefault a (Text.pack (show a)) -{-|-Provide no default value.--}+-- |+-- Provide no default value. defaultless :: Default a defaultless = UnspecifiedDefault - -- ** Value spec-------------------------- -{-|-Derive value format specification from the Enum instance and-explicit mapping of values to their representations.--}+-- |+-- Derive value format specification from the Enum instance and+-- explicit mapping of values to their representations. formattedByEnum :: (Bounded a, Enum a) => (a -> Text) -> ValueFormat a formattedByEnum valueRepresentation = formattedByEnumUsingBuilderMapping (TextBuilder.text . valueRepresentation) -{-|-Derive value format specification from the Enum and Show instances.--}+-- |+-- Derive value format specification from the Enum and Show instances. formattedByEnumUsingShow :: (Bounded a, Enum a, Show a) => ValueFormat a formattedByEnumUsingShow = formattedByEnumUsingBuilderMapping (TextBuilder.string . show) -{-|-Derive value format specification from the Enum instance and-explicit mapping of values to their representations.--}+-- |+-- Derive value format specification from the Enum instance and+-- explicit mapping of values to their representations. formattedByEnumUsingBuilderMapping :: (Bounded a, Enum a) => (a -> TextBuilder.Builder) -> ValueFormat a-formattedByEnumUsingBuilderMapping valueRepresentation = let- values = enumFromTo minBound (asTypeOf maxBound (descriptionToA description))- descriptionToA = undefined :: ValueFormat a -> a- description = EnumValueFormat (fmap valueRepresentation values)- in description+formattedByEnumUsingBuilderMapping valueRepresentation =+ let values = enumFromTo minBound (asTypeOf maxBound (descriptionToA description))+ descriptionToA = undefined :: ValueFormat a -> a+ description = EnumValueFormat (fmap valueRepresentation values)+ in description -{-|-Avoid specifying the format.--}+-- |+-- Avoid specifying the format. unformatted :: ValueFormat a unformatted = UnspecifiedFormat - -- ** Rendering building-------------------------- buildValueFormat :: ValueFormat a -> TextBuilder.Builder-buildValueFormat = \ case+buildValueFormat = \case EnumValueFormat values -> "(" <> TextBuilder.intercalate ", " values <> ")" UnspecifiedFormat -> mempty buildHelp :: Text -> ValueFormat a -> TextBuilder.Builder buildHelp description valueFormat =- TextBuilder.intercalate (TextBuilder.char ' ')+ TextBuilder.intercalate+ (TextBuilder.char ' ') (notNull (TextBuilder.text description) <> notNull (buildValueFormat valueFormat)) where notNull :: TextBuilder.Builder -> [TextBuilder.Builder] notNull = validate (not . TextBuilder.null) - -- ** Rendering-------------------------- renderIfNotEmpty :: TextBuilder.Builder -> Maybe Text renderIfNotEmpty = fmap TextBuilder.run . validate (not . TextBuilder.null) prefixIfMakesSense :: Text -> Text -> Text-prefixIfMakesSense prefix text = if Text.null prefix- then text- else prefix <> "-" <> text-+prefixIfMakesSense prefix text =+ if Text.null prefix+ then text+ else prefix <> "-" <> text -- ** Mods-------------------------- paramHelp :: Text -> ValueFormat a -> Optparse.Mod f a paramHelp description format = foldMap (Optparse.help . Text.unpack) (renderIfNotEmpty (buildHelp description format)) defaultValue :: Optparse.HasValue f => Default a -> Optparse.Mod f a-defaultValue = \ case+defaultValue = \case SpecifiedDefault a text -> Optparse.value a <> Optparse.showDefaultWith (const (Text.unpack text)) UnspecifiedDefault -> mempty
library/Optima/Prelude.hs view
@@ -1,21 +1,18 @@ module Optima.Prelude-(- module Exports,- validate,-)+ ( module Exports,+ validate,+ ) where --- base-------------------------- import Control.Applicative as Exports import Control.Arrow as Exports import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bits as Exports import Data.Bool as Exports@@ -30,18 +27,19 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Identity as Exports-import Data.Int as Exports import Data.IORef as Exports+import Data.Int as Exports import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Monoid as Exports hiding (First (..), Last (..), (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports-import Data.Semigroup as Exports import Data.STRef as Exports+import Data.Semigroup as Exports import Data.String as Exports+import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports@@ -49,12 +47,11 @@ import Data.Word as Exports import Debug.Trace as Exports import Foreign as Exports hiding (void)-import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports@@ -64,17 +61,14 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports---- text---------------------------import Data.Text as Exports (Text)-+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) validate :: Alternative m => (a -> Bool) -> a -> m a-validate predicate value = if predicate value- then pure value- else empty+validate predicate value =+ if predicate value+ then pure value+ else empty
optima.cabal view
@@ -1,5 +1,7 @@+cabal-version: 3.0+ name: optima-version: 0.4.0.3+version: 0.4.0.4 category: CLI, Parsing, Options synopsis: Simple command line interface arguments parser homepage: https://github.com/metrix-ai/optima@@ -9,13 +11,14 @@ copyright: (c) 2018, Metrix.AI license: MIT license-file: LICENSE-build-type: Simple-cabal-version: >=1.10 +common language-settings+ default-extensions: ApplicativeDo, BangPatterns, BinaryLiterals, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, DuplicateRecordFields, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, HexFloatLiterals, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, NumericUnderscores, OverloadedLabels, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns+ default-language: Haskell2010+ library+ import: language-settings hs-source-dirs: library- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010 exposed-modules: Optima other-modules:@@ -24,17 +27,14 @@ attoparsec >=0.13 && <0.15, attoparsec-data >=1.0.5.2 && <1.1, base >=4.9 && <5,- optparse-applicative >=0.15 && <0.18,+ optparse-applicative >=0.15 && <0.19, text >=1.2 && <3, text-builder >=0.6 && <0.7 test-suite demo+ import: language-settings type: exitcode-stdio-1.0 hs-source-dirs: demo- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010- ghc-options: -O2 -threaded "-with-rtsopts=-N"- ghc-prof-options: -O2 -threaded -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1" main-is: Main.hs build-depends: optima,