harg 0.4.2.0 → 0.4.2.1
raw patch · 29 files changed
+1643/−1559 lines, 29 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- README.md +1/−1
- harg.cabal +92/−98
- src/Options/Harg.hs +95/−98
- src/Options/Harg/Cmdline.hs +89/−80
- src/Options/Harg/Config.hs +39/−42
- src/Options/Harg/Construct.hs +251/−239
- src/Options/Harg/Het/All.hs +18/−12
- src/Options/Harg/Het/HList.hs +34/−33
- src/Options/Harg/Het/Nat.hs +4/−3
- src/Options/Harg/Het/Prod.hs +59/−50
- src/Options/Harg/Het/Proofs.hs +20/−22
- src/Options/Harg/Het/Variant.hs +45/−38
- src/Options/Harg/Nested.hs +54/−47
- src/Options/Harg/Operations.hs +216/−200
- src/Options/Harg/Pretty.hs +44/−46
- src/Options/Harg/Single.hs +21/−20
- src/Options/Harg/Sources.hs +39/−41
- src/Options/Harg/Sources/DefaultStr.hs +44/−43
- src/Options/Harg/Sources/Env.hs +53/−52
- src/Options/Harg/Sources/JSON.hs +48/−46
- src/Options/Harg/Sources/NoSource.hs +11/−12
- src/Options/Harg/Sources/Types.hs +59/−52
- src/Options/Harg/Sources/YAML.hs +49/−48
- src/Options/Harg/Subcommands.hs +79/−72
- src/Options/Harg/Types.hs +85/−78
- src/Options/Harg/Util.hs +83/−84
- test/Main.hs +4/−0
- test/Spec.hs +0/−2
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog for harg +## 0.4.2.1 [2020.08.01]++Only cosmetic and functional changes, no library changes:++- Minor CI tweaks+- Format everything with ormolu+ ## 0.4.2.0 [2020.01.27] - Add explicit export and import lists
README.md view
@@ -1,6 +1,6 @@ # harg :nut_and_bolt: -[](https://travis-ci.org/alexpeits/harg)+[](https://github.com/alexpeits/harg/actions) [](https://hackage.haskell.org/package/harg) `harg` is a library for configuring programs by scanning command line arguments,
harg.cabal view
@@ -1,110 +1,104 @@-cabal-version: 2.2+cabal-version: 2.4+name: harg+version: 0.4.2.1+license: BSD-3-Clause+license-file: LICENSE+copyright: Copyright (c) 2020 Alex Peitsinis+maintainer: alexpeitsinis@gmail.com+author: Alex Peitsinis+stability: Experimental+homepage: https://github.com/alexpeits/harg+bug-reports: https://github.com/alexpeits/harg/issues+synopsis: Haskell program configuration using higher kinded data+description:+ Please see the README on GitHub at <https://github.com/alexpeits/harg#readme> -name: harg-version: 0.4.2.0-synopsis: Haskell program configuration using higher kinded data-description: Please see the README on GitHub at <https://github.com/alexpeits/harg#readme>-homepage: https://github.com/alexpeits/harg-bug-reports: https://github.com/alexpeits/harg/issues-author: Alex Peitsinis-maintainer: alexpeitsinis@gmail.com-stability: Experimental-copyright: Copyright (c) 2019 Alex Peitsinis-license: BSD-3-Clause-license-file: LICENSE-build-type: Simple-category: System, CLI, Options, Parsing, HKD+category: System, CLI, Options, Parsing, HKD+build-type: Simple extra-source-files: README.md CHANGELOG.md source-repository head- type: git- location: https://github.com/alexpeits/harg+ type: git+ location: https://github.com/alexpeits/harg library- exposed-modules: Options.Harg- Options.Harg.Cmdline- Options.Harg.Config- Options.Harg.Construct- Options.Harg.Het.All- Options.Harg.Het.HList- Options.Harg.Het.Nat- Options.Harg.Het.Prod- Options.Harg.Het.Proofs- Options.Harg.Het.Variant- Options.Harg.Nested- Options.Harg.Operations- Options.Harg.Pretty- Options.Harg.Single- Options.Harg.Sources- Options.Harg.Sources.DefaultStr- Options.Harg.Sources.Env- Options.Harg.Sources.JSON- Options.Harg.Sources.NoSource- Options.Harg.Sources.Types- Options.Harg.Sources.YAML- Options.Harg.Subcommands- Options.Harg.Types- Options.Harg.Util- hs-source-dirs: src- default-extensions: DataKinds- FlexibleContexts- FlexibleInstances- GADTs- KindSignatures- LambdaCase- MultiParamTypeClasses- RecordWildCards- ScopedTypeVariables- TypeApplications- TypeOperators- ghc-options: -Wall- -Wno-unticked-promoted-constructors- build-depends: base >=4.7 && <5- , aeson >= 1.4.2 && < 1.5- , barbies >= 1.1.0 && < 1.2- , bytestring >= 0.10.8 && < 0.11- , directory >= 1.3.3 && < 1.4- , higgledy >= 0.3.0 && < 0.4- , optparse-applicative >= 0.14.3 && < 0.15- , split >= 0.2.3 && < 0.3- , text >= 1.2.3 && < 1.3- , yaml >= 0.11.0 && < 0.12- default-language: Haskell2010+ exposed-modules:+ Options.Harg+ Options.Harg.Cmdline+ Options.Harg.Config+ Options.Harg.Construct+ Options.Harg.Het.All+ Options.Harg.Het.HList+ Options.Harg.Het.Nat+ Options.Harg.Het.Prod+ Options.Harg.Het.Proofs+ Options.Harg.Het.Variant+ Options.Harg.Nested+ Options.Harg.Operations+ Options.Harg.Pretty+ Options.Harg.Single+ Options.Harg.Sources+ Options.Harg.Sources.DefaultStr+ Options.Harg.Sources.Env+ Options.Harg.Sources.JSON+ Options.Harg.Sources.NoSource+ Options.Harg.Sources.Types+ Options.Harg.Sources.YAML+ Options.Harg.Subcommands+ Options.Harg.Types+ Options.Harg.Util + hs-source-dirs: src+ default-language: Haskell2010+ default-extensions:+ DataKinds FlexibleContexts FlexibleInstances GADTs KindSignatures+ LambdaCase MultiParamTypeClasses RecordWildCards+ ScopedTypeVariables TypeApplications TypeOperators++ ghc-options: -Wall -Wno-unticked-promoted-constructors+ build-depends:+ base >=4.7 && <5,+ aeson >=1.4.2 && <1.5,+ barbies >=1.1.0 && <1.2,+ bytestring >=0.10.8 && <0.11,+ directory >=1.3.3 && <1.4,+ higgledy >=0.3.0 && <0.4,+ optparse-applicative >=0.14.3 && <0.15,+ split >=0.2.3 && <0.3,+ text >=1.2.3 && <1.3,+ yaml >=0.11.0 && <0.12+ test-suite harg-test- type: exitcode-stdio-1.0- main-is: Spec.hs- hs-source-dirs: test- ghc-options: -Wall- -Wno-unticked-promoted-constructors- -threaded- -rtsopts- -with-rtsopts=-N- build-depends: base- , harg- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options:+ -Wall -Wno-unticked-promoted-constructors -threaded -rtsopts+ -with-rtsopts=-N + build-depends:+ base -any,+ harg -any+ test-suite docs-test- type: exitcode-stdio-1.0- hs-source-dirs: docs- main-is: docs.lhs- ghc-options: -Wall- -Wno-unticked-promoted-constructors- -threaded- -Wall- -fno-warn-incomplete-patterns- -fno-warn-missing-signatures- -fno-warn-name-shadowing- -fno-warn-type-defaults- -fno-warn-unused-top-binds- -pgmL markdown-unlit- build-depends: base- , aeson- , barbies- , higgledy- , optparse-applicative- , harg- build-tool-depends: markdown-unlit:markdown-unlit- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: docs.lhs+ build-tool-depends: markdown-unlit:markdown-unlit -any+ hs-source-dirs: docs+ default-language: Haskell2010+ ghc-options:+ -Wall -Wno-unticked-promoted-constructors -threaded -Wall+ -fno-warn-incomplete-patterns -fno-warn-missing-signatures+ -fno-warn-name-shadowing -fno-warn-type-defaults+ -fno-warn-unused-top-binds -pgmL markdown-unlit++ build-depends:+ base -any,+ aeson -any,+ barbies -any,+ higgledy -any,+ optparse-applicative -any,+ harg -any
src/Options/Harg.hs view
@@ -1,117 +1,114 @@ {-# LANGUAGE PatternSynonyms #-}+ module Options.Harg ( -- * Summary -- $summary -- ** Option declaration- option- , flag- , switch- , switch'- , argument-- , Single (..)- , single- , fromSingle-- , Nested (..)- , getNested- , nested- , fromNested-- , AssocListF (..)- , (:+)- , pattern (:+)- , (:->)-- , (:*) (..)- , Tagged (..)-- -- ** Option modifiers- , long- , short- , help- , metavar- , envVar- , defaultVal- , defaultStr- , required- , optional- , Opt+ option,+ flag,+ switch,+ switch',+ argument,+ Single (..),+ single,+ fromSingle,+ Nested (..),+ getNested,+ nested,+ fromNested,+ AssocListF (..),+ (:+),+ pattern (:+),+ (:->),+ (:*) (..),+ Tagged (..), - -- ** Option parsers- , parseWith- , readParser- , strParser- , boolParser- , manyParser+ -- ** Option modifiers+ long,+ short,+ help,+ metavar,+ envVar,+ defaultVal,+ defaultStr,+ required,+ optional,+ Opt, - -- ** Executing options- , execOpt- , execOptDef- , execOptWithCtx- , execOptWithCtxDef- , execCommands- , execCommandsDef- , execCommandsWithCtx- , execCommandsWithCtxDef+ -- ** Option parsers+ parseWith,+ readParser,+ strParser,+ boolParser,+ manyParser, - -- ** Option sources- , EnvSource (..)- , JSONSource (..)- , YAMLSource (..)- , ConfigFile (..)- , noSources- , defaultSources+ -- ** Executing options+ execOpt,+ execOptDef,+ execOptWithCtx,+ execOptWithCtxDef,+ execCommands,+ execCommandsDef,+ execCommandsWithCtx,+ execCommandsWithCtxDef, - -- ** Parser context- , getCtx- , ctxFromArgs- , ctxFromEnv- , pureCtx+ -- ** Option sources+ EnvSource (..),+ JSONSource (..),+ YAMLSource (..),+ ConfigFile (..),+ noSources,+ defaultSources, - -- ** Variant- , VariantF (..)- , fromVariantF- , pattern In1- , pattern In2- , pattern In3- , pattern In4- , pattern In5+ -- ** Parser context+ getCtx,+ ctxFromArgs,+ ctxFromEnv,+ pureCtx, - -- ** Re-exports- -- *** barbies- , B.FunctorB- , B.TraversableB- , B.ProductB- , B.Rec (..)+ -- ** Variant+ VariantF (..),+ fromVariantF,+ pattern In1,+ pattern In2,+ pattern In3,+ pattern In4,+ pattern In5, - -- *** higgledy- , HKD.HKD- , HKD.Build- , HKD.build- , HKD.Construct- , HKD.construct- ) where+ -- ** Re-exports -import Options.Harg.Construct-import Options.Harg.Het.HList-import Options.Harg.Het.Prod-import Options.Harg.Het.Variant-import Options.Harg.Nested-import Options.Harg.Operations-import Options.Harg.Single-import Options.Harg.Sources-import Options.Harg.Sources.Env-import Options.Harg.Sources.JSON-import Options.Harg.Sources.NoSource-import Options.Harg.Sources.Types-import Options.Harg.Sources.YAML-import Options.Harg.Types+ -- *** barbies+ B.FunctorB,+ B.TraversableB,+ B.ProductB,+ B.Rec (..), -import qualified Data.Barbie as B-import qualified Data.Generic.HKD as HKD+ -- *** higgledy+ HKD.HKD,+ HKD.Build,+ HKD.build,+ HKD.Construct,+ HKD.construct,+ )+where +import qualified Data.Barbie as B+import qualified Data.Generic.HKD as HKD+import Options.Harg.Construct+import Options.Harg.Het.HList+import Options.Harg.Het.Prod+import Options.Harg.Het.Variant+import Options.Harg.Nested+import Options.Harg.Operations+import Options.Harg.Single+import Options.Harg.Sources+import Options.Harg.Sources.Env+import Options.Harg.Sources.JSON+import Options.Harg.Sources.NoSource+import Options.Harg.Sources.Types+import Options.Harg.Sources.YAML+import Options.Harg.Types -- $summary --
src/Options/Harg/Cmdline.hs view
@@ -1,104 +1,113 @@ module Options.Harg.Cmdline- ( mkOptparseParser- ) where--import Control.Applicative ((<|>))-import Data.Functor.Compose (Compose (..))-import Data.List (foldl')-import Data.Maybe (fromMaybe)--import qualified Data.Barbie as B-import qualified Options.Applicative as Optparse--import Options.Harg.Pretty (ppHelp)-import Options.Harg.Types+ ( mkOptparseParser,+ )+where +import Control.Applicative ((<|>))+import qualified Data.Barbie as B+import Data.Functor.Compose (Compose (..))+import Data.List (foldl')+import Data.Maybe (fromMaybe)+import qualified Options.Applicative as Optparse+import Options.Harg.Pretty (ppHelp)+import Options.Harg.Types -- | Create a 'Optparse.Parser' from a list of source results and an option -- parser. The source results are folded using '<|>' and then used as a single -- result.-mkOptparseParser- :: forall f a.- ( Applicative f- , B.TraversableB a- , B.ProductB a- )- => [a (Compose Maybe f)] -- ^ Source results- -> a (Compose Opt f) -- ^ Target configuration options- -> Optparse.Parser (a f)-mkOptparseParser sources opts- = B.bsequence $ B.bzipWith mkParser srcOpts opts+mkOptparseParser ::+ forall f a.+ ( Applicative f,+ B.TraversableB a,+ B.ProductB a+ ) =>+ -- | Source results+ [a (Compose Maybe f)] ->+ -- | Target configuration options+ a (Compose Opt f) ->+ Optparse.Parser (a f)+mkOptparseParser sources opts =+ B.bsequence $ B.bzipWith mkParser srcOpts opts where- srcOpts- = foldl'- (B.bzipWith (<|>))- (B.bmap (const (Compose Nothing)) opts)- sources+ srcOpts =+ foldl'+ (B.bzipWith (<|>))+ (B.bmap (const (Compose Nothing)) opts)+ sources -- | Create a 'Optparse.Parser' for a single option, using the accumulated -- source results.-mkParser- :: Compose Maybe f a -- ^ Accumulated source results- -> Compose Opt f a -- ^ Target option- -> Compose Optparse.Parser f a-mkParser srcs opt@(Compose Opt{..})- = case _optType of- OptionOptType -> toOptionParser srcs opt- FlagOptType active -> toFlagParser srcs opt active- ArgumentOptType -> toArgumentParser srcs opt+mkParser ::+ -- | Accumulated source results+ Compose Maybe f a ->+ -- | Target option+ Compose Opt f a ->+ Compose Optparse.Parser f a+mkParser srcs opt@(Compose Opt {..}) =+ case _optType of+ OptionOptType -> toOptionParser srcs opt+ FlagOptType active -> toFlagParser srcs opt active+ ArgumentOptType -> toArgumentParser srcs opt -- | Create a 'Optparse.Parser' for an 'OptionOpt', which results in an -- @optparse-applicative@ 'Optparse.option'.-toOptionParser- :: Compose Maybe f a- -> Compose Opt f a- -> Compose Optparse.Parser f a-toOptionParser sources (Compose opt@Opt{..})- = Compose $ Optparse.option (Optparse.eitherReader _optReader)- ( foldMap (fromMaybe mempty)- [ Optparse.long <$> _optLong- , Optparse.short <$> _optShort- , Optparse.help <$> ppHelp opt- , Optparse.metavar <$> _optMetavar- , Optparse.value <$> (getCompose sources <|> _optDefaultVal)+toOptionParser ::+ Compose Maybe f a ->+ Compose Opt f a ->+ Compose Optparse.Parser f a+toOptionParser sources (Compose opt@Opt {..}) =+ Compose $+ Optparse.option+ (Optparse.eitherReader _optReader)+ ( foldMap+ (fromMaybe mempty)+ [ Optparse.long <$> _optLong,+ Optparse.short <$> _optShort,+ Optparse.help <$> ppHelp opt,+ Optparse.metavar <$> _optMetavar,+ Optparse.value <$> (getCompose sources <|> _optDefaultVal) ] ) -- | Create a 'Optparse.Parser' for a 'FlagOpt', which results in an -- @optparse-applicative@ 'Optparse.flag'.-toFlagParser- :: Compose Maybe f a- -> Compose Opt f a- -> f a- -> Compose Optparse.Parser f a-toFlagParser sources (Compose opt@Opt{..}) active- = Compose- $ case mDef of- Nothing ->- Optparse.flag' active modifiers- Just def ->- Optparse.flag def active modifiers+toFlagParser ::+ Compose Maybe f a ->+ Compose Opt f a ->+ f a ->+ Compose Optparse.Parser f a+toFlagParser sources (Compose opt@Opt {..}) active =+ Compose $+ case mDef of+ Nothing ->+ Optparse.flag' active modifiers+ Just def ->+ Optparse.flag def active modifiers where- mDef- = getCompose sources <|> _optDefaultVal- modifiers- = foldMap (fromMaybe mempty)- [ Optparse.long <$> _optLong- , Optparse.short <$> _optShort- , Optparse.help <$> ppHelp opt- ]+ mDef =+ getCompose sources <|> _optDefaultVal+ modifiers =+ foldMap+ (fromMaybe mempty)+ [ Optparse.long <$> _optLong,+ Optparse.short <$> _optShort,+ Optparse.help <$> ppHelp opt+ ] -- | Create a 'Optparse.Parser' for a 'ArgumentOpt', which results in an -- @optparse-applicative@ 'Optparse.argument'.-toArgumentParser- :: Compose Maybe f a- -> Compose Opt f a- -> Compose Optparse.Parser f a-toArgumentParser sources (Compose opt@Opt{..})- = Compose $ Optparse.argument (Optparse.eitherReader _optReader)- ( foldMap (fromMaybe mempty)- [ Optparse.help <$> ppHelp opt- , Optparse.metavar <$> _optMetavar- , Optparse.value <$> (getCompose sources <|> _optDefaultVal)+toArgumentParser ::+ Compose Maybe f a ->+ Compose Opt f a ->+ Compose Optparse.Parser f a+toArgumentParser sources (Compose opt@Opt {..}) =+ Compose $+ Optparse.argument+ (Optparse.eitherReader _optReader)+ ( foldMap+ (fromMaybe mempty)+ [ Optparse.help <$> ppHelp opt,+ Optparse.metavar <$> _optMetavar,+ Optparse.value <$> (getCompose sources <|> _optDefaultVal) ] )
src/Options/Harg/Config.hs view
@@ -1,55 +1,52 @@ module Options.Harg.Config- ( mkConfigParser- , getConfig- ) where--import Data.Functor.Compose (Compose (..))-import Data.Kind (Type)--import qualified Data.Barbie as B-import qualified Options.Applicative as Optparse--import Options.Harg.Cmdline (mkOptparseParser)-import Options.Harg.Sources (accumSourceResults)-import Options.Harg.Sources.Env (EnvSourceVal(..))-import Options.Harg.Sources.Types-import Options.Harg.Types+ ( mkConfigParser,+ getConfig,+ )+where +import qualified Data.Barbie as B+import Data.Functor.Compose (Compose (..))+import Data.Kind (Type)+import qualified Options.Applicative as Optparse+import Options.Harg.Cmdline (mkOptparseParser)+import Options.Harg.Sources (accumSourceResults)+import Options.Harg.Sources.Env (EnvSourceVal (..))+import Options.Harg.Sources.Types+import Options.Harg.Types -- | Create a 'Optparse.Parser' for the configuration option parser, using -- 'EnvSource' as the only source.-mkConfigParser- :: forall f c.- ( Applicative f- , B.TraversableB c- , B.ProductB c- )- => HargCtx- -> c (Compose Opt f)- -> Optparse.Parser (c f)-mkConfigParser HargCtx{..} conf- = mkOptparseParser envC conf+mkConfigParser ::+ forall f c.+ ( Applicative f,+ B.TraversableB c,+ B.ProductB c+ ) =>+ HargCtx ->+ c (Compose Opt f) ->+ Optparse.Parser (c f)+mkConfigParser HargCtx {..} conf =+ mkOptparseParser envC conf where- (_, envC)- = accumSourceResults- $ runSource (EnvSourceVal _hcEnv) conf+ (_, envC) =+ accumSourceResults $+ runSource (EnvSourceVal _hcEnv) conf -- | Run two option parsers in parallel and return the result of the -- first one. This is used with the configuration parser being the first -- argument, and the target option parser that has been converted to -- the dummy parser using 'Options.Harg.Util.toDummyOpts' as the second -- one.-getConfig- :: HargCtx- -> Optparse.Parser (c (f :: Type -> Type))- -> Optparse.Parser (a (g :: Type -> Type))- -> IO (c f)-getConfig HargCtx{..} confParser optParser = do- let- parser- = (,) <$> confParser <*> optParser- parserInfo- = Optparse.info (Optparse.helper <*> parser) mempty- res- = Optparse.execParserPure Optparse.defaultPrefs parserInfo _hcArgs+getConfig ::+ HargCtx ->+ Optparse.Parser (c (f :: Type -> Type)) ->+ Optparse.Parser (a (g :: Type -> Type)) ->+ IO (c f)+getConfig HargCtx {..} confParser optParser = do+ let parser =+ (,) <$> confParser <*> optParser+ parserInfo =+ Optparse.info (Optparse.helper <*> parser) mempty+ res =+ Optparse.execParserPure Optparse.defaultPrefs parserInfo _hcArgs fst <$> Optparse.handleParseResult res
src/Options/Harg/Construct.hs view
@@ -1,72 +1,71 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-}-module Options.Harg.Construct- ( option- , flag- , switch- , switch'- , argument- , long- , short- , help- , metavar- , envVar- , defaultVal- , defaultStr- , required- , optional- , parseWith- , readParser- , strParser- , boolParser- , manyParser- ) where -import Data.Char (toLower)-import Data.Kind (Constraint)-import Data.String (IsString(..))-import GHC.TypeLits (ErrorMessage(..), TypeError, Symbol, AppendSymbol)-import Text.Read (readMaybe)--import Data.List.Split (splitOn)+module Options.Harg.Construct+ ( option,+ flag,+ switch,+ switch',+ argument,+ long,+ short,+ help,+ metavar,+ envVar,+ defaultVal,+ defaultStr,+ required,+ optional,+ parseWith,+ readParser,+ strParser,+ boolParser,+ manyParser,+ )+where +import Data.Char (toLower)+import Data.Kind (Constraint)+import Data.List.Split (splitOn)+import Data.String (IsString (..))+import GHC.TypeLits (AppendSymbol, ErrorMessage (..), Symbol, TypeError) import Options.Harg.Types-+import Text.Read (readMaybe) class HasLong o (attr :: [OptAttr]) where -- | Add a 'Options.Applicative.long' modifier to an option long :: String -> o attr a -> o attr a instance HasLong OptionOpt a where- long s o = o { _oLong = Just s }+ long s o = o {_oLong = Just s} instance HasLong FlagOpt a where- long s o = o { _fLong = Just s }+ long s o = o {_fLong = Just s} class HasShort o (attr :: [OptAttr]) where -- | Add a 'Options.Applicative.short' modifier to an option short :: Char -> o attr a -> o attr a instance HasShort OptionOpt a where- short c o = o { _oShort = Just c }+ short c o = o {_oShort = Just c} instance HasShort FlagOpt a where- short c o = o { _fShort = Just c }+ short c o = o {_fShort = Just c} class HasHelp o (attr :: [OptAttr]) where -- | Add 'Options.Applicative.help' to an option help :: String -> o attr a -> o attr a instance HasHelp OptionOpt a where- help s o = o { _oHelp = Just s }+ help s o = o {_oHelp = Just s} instance HasHelp FlagOpt a where- help s o = o { _fHelp = Just s }+ help s o = o {_fHelp = Just s} instance HasHelp ArgumentOpt a where- help s o = o { _aHelp = Just s }+ help s o = o {_aHelp = Just s} class HasMetavar o (attr :: [OptAttr]) where -- | Add a 'Options.Applicative.metavar' metavar to an option, to be@@ -74,68 +73,73 @@ metavar :: String -> o attr a -> o attr a instance HasMetavar OptionOpt a where- metavar s o = o { _oMetavar = Just s }+ metavar s o = o {_oMetavar = Just s} instance HasMetavar ArgumentOpt a where- metavar s o = o { _aMetavar = Just s }+ metavar s o = o {_aMetavar = Just s} class HasEnvVar o (attr :: [OptAttr]) where -- | Specify an environment variable to lookup for an option envVar :: String -> o attr a -> o attr a instance HasEnvVar OptionOpt a where- envVar s o = o { _oEnvVar = Just s }+ envVar s o = o {_oEnvVar = Just s} instance HasEnvVar FlagOpt a where- envVar s o = o { _fEnvVar = Just s }+ envVar s o = o {_fEnvVar = Just s} instance HasEnvVar ArgumentOpt a where- envVar s o = o { _aEnvVar = Just s }+ envVar s o = o {_aEnvVar = Just s} class HasDefaultVal o (attr :: [OptAttr]) where -- | Add a default value to an option. Cannot be used in conjuction with -- with 'required', 'defaultStr' or 'optional'.- defaultVal- :: ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "defaultVal" '["defaultStr", "required"])- , NotInAttrs OptOptional attr (IncompatibleAttrsErr "defaultVal" "optional")- )- => a -> o attr a -> o (OptDefault ': attr) a+ defaultVal ::+ ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "defaultVal" '["defaultStr", "required"]),+ NotInAttrs OptOptional attr (IncompatibleAttrsErr "defaultVal" "optional")+ ) =>+ a ->+ o attr a ->+ o (OptDefault ': attr) a instance HasDefaultVal OptionOpt a where- defaultVal a o = o { _oDefaultVal = Just a }+ defaultVal a o = o {_oDefaultVal = Just a} instance HasDefaultVal ArgumentOpt a where- defaultVal a o = o { _aDefaultVal = Just a }+ defaultVal a o = o {_aDefaultVal = Just a} class HasDefaultStr o (attr :: [OptAttr]) where -- | Add a default unparsed value to an option. Cannot be used in conjuction -- with 'defaultVal', 'required' or 'optional'.- defaultStr- :: ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "defaultStr" '["defaultVal", "required"])- , NotInAttrs OptOptional attr (IncompatibleAttrsErr "defaultStr" "optional")- )- => String -> o attr a -> o (OptDefault ': attr) a+ defaultStr ::+ ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "defaultStr" '["defaultVal", "required"]),+ NotInAttrs OptOptional attr (IncompatibleAttrsErr "defaultStr" "optional")+ ) =>+ String ->+ o attr a ->+ o (OptDefault ': attr) a instance HasDefaultStr OptionOpt a where- defaultStr s o = o { _oDefaultStr = Just s }+ defaultStr s o = o {_oDefaultStr = Just s} instance HasDefaultStr ArgumentOpt a where- defaultStr s o = o { _aDefaultStr = Just s }+ defaultStr s o = o {_aDefaultStr = Just s} class HasRequired o (attr :: [OptAttr]) where -- | Mark an option as required. Cannot be used in conjunction with -- 'optional', 'defaultVal' or 'requiredStr'.- required- :: ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "required" '["defaultVal", "defaultStr"])- , NotInAttrs OptOptional attr (IncompatibleAttrsErr "required" "optional")- )- => o attr a -> o (OptDefault ': attr) a+ required ::+ ( NotInAttrs OptDefault attr (DuplicateAttrMultipleErr "required" '["defaultVal", "defaultStr"]),+ NotInAttrs OptOptional attr (IncompatibleAttrsErr "required" "optional")+ ) =>+ o attr a ->+ o (OptDefault ': attr) a instance HasRequired OptionOpt a where- required o = o { _oDefaultVal = Nothing }+ required o = o {_oDefaultVal = Nothing} instance HasRequired ArgumentOpt a where- required o = o { _aDefaultVal = Nothing }+ required o = o {_aDefaultVal = Nothing} -- | Class for options that can be optional. Cannot be used in conjunction with -- 'HasDefaultVal', 'HasDefaultStr' or 'HasRequired'. Note that this will turn a@@ -155,35 +159,36 @@ -- | Specify that an option is optional. This will convert an @Opt a@ to an -- @Opt (Maybe a)@. Cannot be used in conjunction with 'defaultVal', 'defaultStr' -- or 'required'.- optional- :: ( NotInAttrs OptOptional attr (DuplicateAttrErr "optional")- , NotInAttrs OptDefault attr (IncompatibleAttrsErr "optional" "defaultVal")- )- => o attr a -> o (OptOptional ': attr) (Maybe a)+ optional ::+ ( NotInAttrs OptOptional attr (DuplicateAttrErr "optional"),+ NotInAttrs OptDefault attr (IncompatibleAttrsErr "optional" "defaultVal")+ ) =>+ o attr a ->+ o (OptOptional ': attr) (Maybe a) instance HasOptional OptionOpt a where- optional OptionOpt{..}- = OptionOpt- { _oLong = _oLong- , _oShort = _oShort- , _oHelp = _oHelp- , _oMetavar = _oMetavar- , _oEnvVar = _oEnvVar- , _oDefaultVal = Just Nothing- , _oDefaultStr = Nothing- , _oReader = fmap Just . _oReader- }+ optional OptionOpt {..} =+ OptionOpt+ { _oLong = _oLong,+ _oShort = _oShort,+ _oHelp = _oHelp,+ _oMetavar = _oMetavar,+ _oEnvVar = _oEnvVar,+ _oDefaultVal = Just Nothing,+ _oDefaultStr = Nothing,+ _oReader = fmap Just . _oReader+ } instance HasOptional ArgumentOpt a where- optional ArgumentOpt{..}- = ArgumentOpt- { _aHelp = _aHelp- , _aMetavar = _aMetavar- , _aEnvVar = _aEnvVar- , _aDefaultVal = Just Nothing- , _aDefaultStr = Nothing- , _aReader = fmap Just . _aReader- }+ optional ArgumentOpt {..} =+ ArgumentOpt+ { _aHelp = _aHelp,+ _aMetavar = _aMetavar,+ _aEnvVar = _aEnvVar,+ _aDefaultVal = Just Nothing,+ _aDefaultStr = Nothing,+ _aReader = fmap Just . _aReader+ } -- | Class to convert an intermediate option type into 'Opt'. Instances -- should set the appropriate '_optType'.@@ -192,46 +197,46 @@ toOpt :: o attr a -> Opt a instance IsOpt OptionOpt attr where- toOpt OptionOpt{..}- = Opt- { _optLong = _oLong- , _optShort = _oShort- , _optHelp = _oHelp- , _optMetavar = _oMetavar- , _optEnvVar = _oEnvVar- , _optDefaultVal = _oDefaultVal- , _optDefaultStr = _oDefaultStr- , _optReader = _oReader- , _optType = OptionOptType- }+ toOpt OptionOpt {..} =+ Opt+ { _optLong = _oLong,+ _optShort = _oShort,+ _optHelp = _oHelp,+ _optMetavar = _oMetavar,+ _optEnvVar = _oEnvVar,+ _optDefaultVal = _oDefaultVal,+ _optDefaultStr = _oDefaultStr,+ _optReader = _oReader,+ _optType = OptionOptType+ } instance IsOpt FlagOpt attr where- toOpt FlagOpt{..}- = Opt- { _optLong = _fLong- , _optShort = _fShort- , _optHelp = _fHelp- , _optMetavar = Nothing- , _optEnvVar = _fEnvVar- , _optDefaultVal = Just _fDefaultVal- , _optDefaultStr = Nothing- , _optReader = _fReader- , _optType = FlagOptType _fActive- }+ toOpt FlagOpt {..} =+ Opt+ { _optLong = _fLong,+ _optShort = _fShort,+ _optHelp = _fHelp,+ _optMetavar = Nothing,+ _optEnvVar = _fEnvVar,+ _optDefaultVal = Just _fDefaultVal,+ _optDefaultStr = Nothing,+ _optReader = _fReader,+ _optType = FlagOptType _fActive+ } instance IsOpt ArgumentOpt attr where- toOpt ArgumentOpt{..}- = Opt- { _optLong = Nothing- , _optShort = Nothing- , _optHelp = _aHelp- , _optMetavar = _aMetavar- , _optEnvVar = _aEnvVar- , _optDefaultVal = _aDefaultVal- , _optDefaultStr = _aDefaultStr- , _optReader = _aReader- , _optType = ArgumentOptType- }+ toOpt ArgumentOpt {..} =+ Opt+ { _optLong = Nothing,+ _optShort = Nothing,+ _optHelp = _aHelp,+ _optMetavar = _aMetavar,+ _optEnvVar = _aEnvVar,+ _optDefaultVal = _aDefaultVal,+ _optDefaultStr = _aDefaultStr,+ _optReader = _aReader,+ _optType = ArgumentOptType+ } -- | Create an option parser, equivalent to 'Options.Applicative.option'. The -- second argument is the modifiers to add to the option, and can be defined by@@ -246,24 +251,24 @@ -- . defaultVal 256 -- ) -- @-option- :: OptReader a- -> (OptionOpt '[] a -> OptionOpt attr b)- -> Opt b-option p f- = toOpt $ f opt+option ::+ OptReader a ->+ (OptionOpt '[] a -> OptionOpt attr b) ->+ Opt b+option p f =+ toOpt $ f opt where- opt- = OptionOpt- { _oLong = Nothing- , _oShort = Nothing- , _oHelp = Nothing- , _oMetavar = Nothing- , _oEnvVar = Nothing- , _oDefaultVal = Nothing- , _oDefaultStr = Nothing- , _oReader = p- }+ opt =+ OptionOpt+ { _oLong = Nothing,+ _oShort = Nothing,+ _oHelp = Nothing,+ _oMetavar = Nothing,+ _oEnvVar = Nothing,+ _oDefaultVal = Nothing,+ _oDefaultStr = Nothing,+ _oReader = p+ } -- | Create a flag parser, equivalent to 'Options.Applicative.option'. The -- first argument is the default value (returned when the flag modifier is@@ -279,24 +284,26 @@ -- . help "Some flag" -- ) -- @-flag- :: a -- ^ Default value- -> a -- ^ Active value- -> (FlagOpt '[] a -> FlagOpt attr b)- -> Opt b-flag d active f- = toOpt $ f opt+flag ::+ -- | Default value+ a ->+ -- | Active value+ a ->+ (FlagOpt '[] a -> FlagOpt attr b) ->+ Opt b+flag d active f =+ toOpt $ f opt where- opt- = FlagOpt- { _fLong = Nothing- , _fShort = Nothing- , _fHelp = Nothing- , _fEnvVar = Nothing- , _fDefaultVal = d- , _fActive = active- , _fReader = const (pure d) -- TODO- }+ opt =+ FlagOpt+ { _fLong = Nothing,+ _fShort = Nothing,+ _fHelp = Nothing,+ _fEnvVar = Nothing,+ _fDefaultVal = d,+ _fActive = active,+ _fReader = const (pure d) -- TODO+ } -- | A 'flag' parser, specialized to 'Bool'. The parser (e.g. when parsing -- an environment variable) will accept @true@ and @false@, but case@@ -311,25 +318,25 @@ -- . help "Some switch" -- ) -- @-switch- :: (FlagOpt '[] Bool -> FlagOpt attr Bool)- -> Opt Bool-switch f- = fl { _optReader = boolParser }+switch ::+ (FlagOpt '[] Bool -> FlagOpt attr Bool) ->+ Opt Bool+switch f =+ fl {_optReader = boolParser} where- fl- = flag False True f+ fl =+ flag False True f -- | Similar to 'switch', but the default value is 'True' and the active is -- 'False'.-switch'- :: (FlagOpt '[] Bool -> FlagOpt attr Bool)- -> Opt Bool-switch' f- = fl { _optReader = boolParser }+switch' ::+ (FlagOpt '[] Bool -> FlagOpt attr Bool) ->+ Opt Bool+switch' f =+ fl {_optReader = boolParser} where- fl- = flag True False f+ fl =+ flag True False f -- | Create an argument parser, equivalent to 'Options.Applicative.argument'. -- The second argument is the modifiers to add to the option, and can be@@ -343,82 +350,87 @@ -- . defaultVal "this is the default" -- ) -- @-argument- :: OptReader a- -> (ArgumentOpt '[] a -> ArgumentOpt attr b)- -> Opt b-argument p f- = toOpt $ f opt+argument ::+ OptReader a ->+ (ArgumentOpt '[] a -> ArgumentOpt attr b) ->+ Opt b+argument p f =+ toOpt $ f opt where- opt- = ArgumentOpt- { _aHelp = Nothing- , _aMetavar = Nothing- , _aEnvVar = Nothing- , _aDefaultVal = Nothing- , _aDefaultStr = Nothing- , _aReader = p- }+ opt =+ ArgumentOpt+ { _aHelp = Nothing,+ _aMetavar = Nothing,+ _aEnvVar = Nothing,+ _aDefaultVal = Nothing,+ _aDefaultStr = Nothing,+ _aReader = p+ } -- | Convert a parser that returns 'Maybe' to a parser that returns 'Either', -- with the default 'Left' value @unable to parse: \<input\>@.-parseWith- :: (String -> Maybe a) -- ^ Original parser- -> (String -> Either String a)-parseWith parser s- = maybe (Left err) Right (parser s)+parseWith ::+ -- | Original parser+ (String -> Maybe a) ->+ (String -> Either String a)+parseWith parser s =+ maybe (Left err) Right (parser s) where- err- = "Unable to parse: " <> s+ err =+ "Unable to parse: " <> s -- | A parser that uses the 'Read' instance to parse into a type. readParser :: Read a => OptReader a-readParser- = parseWith readMaybe+readParser =+ parseWith readMaybe -- | A parser that returns a string. Any type that has an instance of -- 'IsString' will work, and this parser always succeeds.-strParser- :: IsString s- => String- -> Either String s-strParser- = pure . fromString+strParser ::+ IsString s =>+ String ->+ Either String s+strParser =+ pure . fromString -- | A parser that returns a 'Bool'. This will succeed for the strings -- @true@ and @false@ in a case-insensitive manner. boolParser :: String -> Either String Bool-boolParser s- = case map toLower s of- "true" -> Right True- "false" -> Right False- _ -> Left ("Unable to parse " <> s <> " to Bool")+boolParser s =+ case map toLower s of+ "true" -> Right True+ "false" -> Right False+ _ -> Left ("Unable to parse " <> s <> " to Bool") -- | A parser that can parse many items, returning a list.-manyParser- :: String -- ^ Separator- -> OptReader a -- ^ Parser for each string- -> OptReader [a]-manyParser sep parser- = traverse parser . splitOn sep+manyParser ::+ -- | Separator+ String ->+ -- | Parser for each string+ OptReader a ->+ OptReader [a]+manyParser sep parser =+ traverse parser . splitOn sep -- | Wrap a symbol in quotes, for pretty printing in type errors.-type QuoteSym (s :: Symbol)- = 'Text "`" :<>: 'Text s :<>: 'Text "`"+type QuoteSym (s :: Symbol) =+ 'Text "`" :<>: 'Text s :<>: 'Text "`" -- | Check if `x` is not an element of the type-level list `xs`. If it is -- print the appropriate error message using `l` and `r` for clarity.-type family NotInAttrs+type family+ NotInAttrs (x :: k) (xs :: [k])- (err :: ErrorMessage)- :: Constraint where- NotInAttrs _ '[] _- = ()- NotInAttrs x (x ': _) err- = TypeError err- NotInAttrs x (y ': xs) err- = NotInAttrs x xs err+ (err :: ErrorMessage) ::+ Constraint+ where+ NotInAttrs _ '[] _ =+ ()+ NotInAttrs x (x ': _) err =+ TypeError err+ NotInAttrs x (y ': xs) err =+ NotInAttrs x xs err type family CommaSep (xs :: [Symbol]) :: Symbol where CommaSep '[] = ""@@ -426,20 +438,20 @@ CommaSep (x ': xs) = " or one of " `AppendSymbol` CommaSep' x xs type family CommaSep' (s :: Symbol) (xs :: [Symbol]) :: Symbol where- CommaSep' s '[] = s+ CommaSep' s '[] = s CommaSep' s (x ': xs) = CommaSep' (s `AppendSymbol` ", " `AppendSymbol` x) xs -type DuplicateAttrErr attr- = QuoteSym attr- :<>: 'Text " is already specified."+type DuplicateAttrErr attr =+ QuoteSym attr+ :<>: 'Text " is already specified." -type DuplicateAttrMultipleErr attr rest- = QuoteSym attr- :<>: 'Text (CommaSep rest)- :<>: 'Text " has already been specified."+type DuplicateAttrMultipleErr attr rest =+ QuoteSym attr+ :<>: 'Text (CommaSep rest)+ :<>: 'Text " has already been specified." -type IncompatibleAttrsErr l r- = QuoteSym l- :<>: 'Text " and "- :<>: QuoteSym r- :<>: 'Text " cannot be mixed in an option definition."+type IncompatibleAttrsErr l r =+ QuoteSym l+ :<>: 'Text " and "+ :<>: QuoteSym r+ :<>: 'Text " cannot be mixed in an option definition."
src/Options/Harg/Het/All.hs view
@@ -1,27 +1,33 @@-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-}+ module Options.Harg.Het.All- ( All- ) where+ ( All,+ )+where -import Data.Kind (Type, Constraint)+import Data.Kind (Constraint, Type) -- | @All c xs@ returns a constraint which is constructed by -- applying @c@ to all the types in @xs@.-type family All+type family+ All (c :: k -> Constraint)- (xs :: [k])- :: Constraint where- All _ '[] = ()+ (xs :: [k]) ::+ Constraint+ where+ All _ '[] = () All c (x ': xs) = (c x, All c xs) -- | @AllF c xs f@ is similar to 'All', but types in @xs@ have the kind @(Type -- -> Type) -> Type@ so they require an extra @f :: Type -> Type@ in order to -- be of fully saturated.-type family AllF+type family+ AllF (c :: k -> Constraint) (xs :: [(Type -> Type) -> Type])- (f :: Type -> Type)- :: Constraint where- AllF _ '[] _ = ()+ (f :: Type -> Type) ::+ Constraint+ where+ AllF _ '[] _ = () AllF c (x ': xs) f = (c (x f), AllF c xs f)
src/Options/Harg/Het/HList.hs view
@@ -1,29 +1,31 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Het.HList- ( MapAssocList (..)- , AssocListF (..)- , (:+)- , pattern (:+)- , (:->)- ) where -import Data.Kind (Type)-import GHC.TypeLits (ErrorMessage(..), TypeError, Symbol)--import qualified Data.Barbie as B+module Options.Harg.Het.HList+ ( MapAssocList (..),+ AssocListF (..),+ (:+),+ pattern (:+),+ (:->),+ )+where +import qualified Data.Barbie as B+import Data.Kind (Type)+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError) -- | A heterogeneous list that holds higher-kinded types and the associated -- type constructor, along with a type level list of 'Symbol's that act -- as tags for each type.-data AssocListF+data+ AssocListF (ts :: [Symbol]) (xs :: [(Type -> Type) -> Type])- (f :: Type -> Type) where- ANil :: AssocListF '[] '[] f+ (f :: Type -> Type)+ where+ ANil :: AssocListF '[] '[] f ACons :: x f -> AssocListF ts xs f -> AssocListF (t ': ts) (x ': xs) f -- | Helper type-level function to construct an 'AssocList' which is not@@ -37,17 +39,16 @@ -- -- @Config@ above has type @(Type -> Type) -> Type@, and requires a type -- like 'Opt' to be fully applied.--- type family l :+ r = (res :: (Type -> Type) -> Type) where (tl :-> vl) :+ (tr :-> vr) = AssocListF '[tl, tr] '[vl, vr] (tl :-> vl) :+ AssocListF ts vs = AssocListF (tl ': ts) (vl ': vs)- l :+ r- = TypeError- ( 'Text "Invalid type for tagged options. Construct like this:"- :$$: 'Text "type MyConfig"- :$$: 'Text " = \"one\" :-> ConfigForOne"- :$$: 'Text " :+ \"two\" :-> ConfigForTwo"- )+ l :+ r =+ TypeError+ ( 'Text "Invalid type for tagged options. Construct like this:"+ :$$: 'Text "type MyConfig"+ :$$: 'Text " = \"one\" :-> ConfigForOne"+ :$$: 'Text " :+ \"two\" :-> ConfigForTwo"+ ) pattern (:+) :: x f -> AssocListF ts xs f -> AssocListF (t ': ts) (x ': xs) f pattern x :+ xs = ACons x xs@@ -60,15 +61,15 @@ class MapAssocList (as :: [(Type -> Type) -> Type]) where -- | Apply a function to all higher-kinded types in an 'AssocList'.- mapAssocList- :: (forall a. B.FunctorB a => a f -> a g)- -> AssocListF ts as f- -> AssocListF ts as g+ mapAssocList ::+ (forall a. B.FunctorB a => a f -> a g) ->+ AssocListF ts as f ->+ AssocListF ts as g instance MapAssocList '[] where- mapAssocList _ ANil- = ANil+ mapAssocList _ ANil =+ ANil instance (MapAssocList as, B.FunctorB a) => MapAssocList (a ': as) where- mapAssocList f (ACons x xs)- = ACons (f x) (mapAssocList f xs)+ mapAssocList f (ACons x xs) =+ ACons (f x) (mapAssocList f xs)
src/Options/Harg/Het/Nat.hs view
@@ -1,7 +1,8 @@ module Options.Harg.Het.Nat- ( Nat (..)- , SNat (..)- ) where+ ( Nat (..),+ SNat (..),+ )+where -- | Type-level Peano natural number. data Nat
src/Options/Harg/Het/Prod.hs view
@@ -1,26 +1,26 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Het.Prod- ( (:*) (..)- , Tagged (..)- ) where--import Data.Functor.Identity (Identity)-import Data.Kind (Type)-import Data.Proxy (Proxy(..))-import GHC.Generics (Generic)-import GHC.TypeLits (KnownSymbol, symbolVal)+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-} -import Data.Aeson ((.:?), (.!=))-import qualified Data.Aeson as JSON-import qualified Data.Barbie as B-import qualified Data.Text as Tx+module Options.Harg.Het.Prod+ ( (:*) (..),+ Tagged (..),+ )+where +import Data.Aeson ((.!=), (.:?))+import qualified Data.Aeson as JSON+import qualified Data.Barbie as B+import Data.Functor.Identity (Identity)+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import qualified Data.Text as Tx+import GHC.Generics (Generic)+import GHC.TypeLits (KnownSymbol, symbolVal) -- | Infix version of 'Data.Functor.Product'. Allows to combine -- higher-kinded types, and keep them partially applied until needed:@@ -34,9 +34,10 @@ -- configOpt :: Config Opt -- configOpt = ... -- @--- data- ((a :: (Type -> Type) -> Type) :* (b :: (Type -> Type) -> Type))+ ( (a :: (Type -> Type) -> Type)+ :* (b :: (Type -> Type) -> Type)+ ) (f :: Type -> Type) = a f :* b f deriving (Generic, B.FunctorB, B.TraversableB, B.ProductB)@@ -44,19 +45,20 @@ infixr 4 :* deriving instance- ( Show (a Identity)- , Show (b Identity)- ) => Show ((a :* b) Identity)+ ( Show (a Identity),+ Show (b Identity)+ ) =>+ Show ((a :* b) Identity) -- | This type adds a type-level phantom tag to a higher-kinded type. -- Its JSON instance allows using ':*' with 'Options.Harg.Sources.JSON.JSONSource'.-newtype Tagged+newtype+ Tagged (t :: k) (a :: (Type -> Type) -> Type)- (f :: Type -> Type)- = Tagged- { unTagged :: a f- }+ (f :: Type -> Type) = Tagged+ { unTagged :: a f+ } deriving (Generic) deriving newtype instance JSON.FromJSON (a f) => JSON.FromJSON (Tagged t a f)@@ -73,29 +75,36 @@ -- The following JSON instances need to work if and only if all elements in -- the product are `Tagged`, hence the weird pattern matches-instance ( JSON.FromJSON (a Maybe)- , JSON.FromJSON (b' Maybe)- , B.ProductB a, B.ProductB b'- , KnownSymbol ta- , b' ~ (Tagged tb b :* c)- ) => JSON.FromJSON ((Tagged ta a :* (Tagged tb b :* c)) Maybe) where- parseJSON- = JSON.withObject ":*"- $ \o ->- (:*)+instance+ ( JSON.FromJSON (a Maybe),+ JSON.FromJSON (b' Maybe),+ B.ProductB a,+ B.ProductB b',+ KnownSymbol ta,+ b' ~ (Tagged tb b :* c)+ ) =>+ JSON.FromJSON ((Tagged ta a :* (Tagged tb b :* c)) Maybe)+ where+ parseJSON =+ JSON.withObject ":*" $+ \o ->+ (:*) <$> o .:? Tx.pack (symbolVal (Proxy :: Proxy ta)) .!= B.buniq Nothing <*> JSON.parseJSON (JSON.Object o) instance- ( JSON.FromJSON (a Maybe)- , JSON.FromJSON (b Maybe)- , B.ProductB a, B.ProductB b- , KnownSymbol ta- , KnownSymbol tb- ) => JSON.FromJSON ((Tagged ta a :* Tagged tb b) Maybe) where- parseJSON- = JSON.withObject ":*"- $ \o ->- (:*)+ ( JSON.FromJSON (a Maybe),+ JSON.FromJSON (b Maybe),+ B.ProductB a,+ B.ProductB b,+ KnownSymbol ta,+ KnownSymbol tb+ ) =>+ JSON.FromJSON ((Tagged ta a :* Tagged tb b) Maybe)+ where+ parseJSON =+ JSON.withObject ":*" $+ \o ->+ (:*) <$> o .:? Tx.pack (symbolVal (Proxy :: Proxy ta)) .!= B.buniq Nothing <*> o .:? Tx.pack (symbolVal (Proxy :: Proxy tb)) .!= B.buniq Nothing
src/Options/Harg/Het/Proofs.hs view
@@ -1,28 +1,29 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+ -- | This module provides type-level functions that need proofs to work -- properly.-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-} module Options.Harg.Het.Proofs- ( type (++)- , Proof (..)- , hgcastWith- ) where+ ( type (++),+ Proof (..),+ hgcastWith,+ )+where -import Data.Kind (Type)+import Data.Kind (Type) import Data.Type.Equality - -- | Same as 'Data.Type.Equality.gcastWith' but for heterogeneous propositional -- equality-hgcastWith- :: forall (a :: k) (b :: k') (r :: Type).- (a :~~: b)- -> (a ~~ b => r)- -> r+hgcastWith ::+ forall (a :: k) (b :: k') (r :: Type).+ (a :~~: b) ->+ (a ~~ b => r) ->+ r hgcastWith HRefl x = x -- * Concatenation of type-level lists@@ -33,9 +34,8 @@ -- > :kind! '[Int, Bool] ++ '[Char, Maybe Int] -- '[Int, Bool, Char, Maybe Int] -- @--- type family (xs :: [k]) ++ (ts :: [k]) = (res :: [k]) where- '[] ++ ys = ys+ '[] ++ ys = ys (x ': xs) ++ ys = x ': (xs ++ ys) -- | Proof that appending an empty list to any list has no effect on the latter.@@ -61,9 +61,7 @@ -- | Induction on the tail of the list instance Proof xs y (z ': zs) => Proof (x ': xs) y (z ': zs) where- proof- :: x ': (xs ++ (y ': z ': zs))- :~~: x ': ((xs ++ '[y]) ++ (z ': zs))+ proof :: x ': (xs ++ (y ': z ': zs)) :~~: x ': ((xs ++ '[y]) ++ (z ': zs)) proof = hgcastWith (proof @xs @y @(z ': zs)) HRefl instance Proof '[] y '[] where
src/Options/Harg/Het/Variant.hs view
@@ -1,25 +1,24 @@-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Het.Variant- ( VariantF (..)- , fromVariantF- , InjectPosF (..)- , pattern In1- , pattern In2- , pattern In3- , pattern In4- , pattern In5- ) where--import Data.Kind (Type)--import qualified Data.Barbie as B+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -import Options.Harg.Het.Nat+module Options.Harg.Het.Variant+ ( VariantF (..),+ fromVariantF,+ InjectPosF (..),+ pattern In1,+ pattern In2,+ pattern In3,+ pattern In4,+ pattern In5,+ )+where +import qualified Data.Barbie as B+import Data.Kind (Type)+import Options.Harg.Het.Nat -- | A Variant is similar to nested 'Either's. For example, @Variant '[Int, -- Bool, Char]@ is isomorphic to @Either Int (Either Bool Char)@. 'VariantF'@@ -32,32 +31,36 @@ -- getFromVariant :: Variant '[Int, Bool, String] -> Bool -- getFromVariant (ThereF (HereF b)) = b -- @--- data VariantF (xs :: [(Type -> Type) -> Type]) (f :: Type -> Type) where- HereF :: x f -> VariantF (x ': xs) f+ HereF :: x f -> VariantF (x ': xs) f ThereF :: VariantF xs f -> VariantF (y ': xs) f instance- ( B.FunctorB x- , B.FunctorB (VariantF xs)- ) => B.FunctorB (VariantF (x ': xs)) where- bmap nat (HereF x) = HereF $ B.bmap nat x+ ( B.FunctorB x,+ B.FunctorB (VariantF xs)+ ) =>+ B.FunctorB (VariantF (x ': xs))+ where+ bmap nat (HereF x) = HereF $ B.bmap nat x bmap nat (ThereF xs) = ThereF $ B.bmap nat xs instance B.FunctorB (VariantF '[]) where bmap _ _ = error "Impossible: empty variant" instance- ( B.TraversableB x- , B.TraversableB (VariantF xs)- ) => B.TraversableB (VariantF (x ': xs)) where- btraverse nat (HereF x) = HereF <$> B.btraverse nat x+ ( B.TraversableB x,+ B.TraversableB (VariantF xs)+ ) =>+ B.TraversableB (VariantF (x ': xs))+ where+ btraverse nat (HereF x) = HereF <$> B.btraverse nat x btraverse nat (ThereF xs) = ThereF <$> B.btraverse nat xs instance B.TraversableB (VariantF '[]) where btraverse _ _ = error "Impossible: empty variant" -- * Helpers for pattern-matching on variants+ pattern In1 :: x1 f -> VariantF (x1 ': xs) f pattern In1 x = HereF x @@ -74,6 +77,7 @@ pattern In5 x = ThereF (In4 x) -- https://github.com/i-am-tom/learn-me-a-haskell/blob/master/src/OneOf/Fold.hs+ -- | Create the signature needed for 'FromVariantF' to work. This constructs a -- function that takes as arguments functions that can act upon each item in -- the list that the 'VariantF' holds. For example, @VariantF [a, b, c]@@ -82,7 +86,6 @@ -- @ -- VariantF [a, b, c] f -> (a f -> r) -> (b f -> r) -> (c f -> r) -> r -- @--- type family FoldSignatureF (xs :: [(Type -> Type) -> Type]) r f where FoldSignatureF (x ': xs) r f = (x f -> r) -> FoldSignatureF xs r f FoldSignatureF '[] r f = r@@ -91,16 +94,18 @@ fromVariantF :: VariantF xs f -> FoldSignatureF xs result f instance FromVariantF '[x] result f where- fromVariantF (HereF x) f = f x+ fromVariantF (HereF x) f = f x fromVariantF (ThereF _) _ = error "Impossible: empty variant" instance- ( tail ~ (x' ': xs)- , FromVariantF tail result f- , IgnoreF tail result f- ) => FromVariantF (x ': x' ': xs) result f where+ ( tail ~ (x' ': xs),+ FromVariantF tail result f,+ IgnoreF tail result f+ ) =>+ FromVariantF (x ': x' ': xs) result f+ where fromVariantF (ThereF x) _ = fromVariantF @_ @result x- fromVariantF (HereF x) f = ignoreF @tail (f x)+ fromVariantF (HereF x) f = ignoreF @tail (f x) class IgnoreF (args :: [(Type -> Type) -> Type]) result f where ignoreF :: result -> FoldSignatureF args result f@@ -117,11 +122,13 @@ -- the variant holds, can give the injection @b f -> VariantF [a, b, c] f@. -- The injection can as well be constructed without providing the position, but -- it helps in case @x@ is not unique in @xs@.-class InjectPosF+class+ InjectPosF (n :: Nat) (x :: (Type -> Type) -> Type) (xs :: [(Type -> Type) -> Type])- | n xs -> x where+ | n xs -> x+ where injectPosF :: SNat n -> (x f -> VariantF xs f) instance InjectPosF Z x (x ': xs) where
src/Options/Harg/Nested.hs view
@@ -1,44 +1,48 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE UndecidableInstances #-}-+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-module Options.Harg.Nested- ( Nested (..)- , nested- , getNested- , fromNested- ) where -import Data.Coerce (Coercible, coerce)-import Data.Functor.Identity (Identity(..))-import Data.Kind (Type)-import GHC.Generics (Generic)+module Options.Harg.Nested+ ( Nested (..),+ nested,+ getNested,+ fromNested,+ )+where -import qualified Data.Aeson as JSON-import qualified Data.Barbie as B-import qualified Data.Generic.HKD as HKD+import qualified Data.Aeson as JSON+import qualified Data.Barbie as B+import Data.Coerce (Coercible, coerce)+import Data.Functor.Identity (Identity (..))+import qualified Data.Generic.HKD as HKD+import Data.Kind (Type)+import GHC.Generics (Generic) -- Orphan HKD FromJSON instance-instance JSON.GFromJSON JSON.Zero (HKD.HKD_ f structure)- => JSON.FromJSON (HKD.HKD structure f) where- parseJSON- = fmap HKD.HKD- . JSON.gParseJSON JSON.defaultOptions JSON.NoFromArgs+instance+ JSON.GFromJSON JSON.Zero (HKD.HKD_ f structure) =>+ JSON.FromJSON (HKD.HKD structure f)+ where+ parseJSON =+ fmap HKD.HKD+ . JSON.gParseJSON JSON.defaultOptions JSON.NoFromArgs -- | Newtype wrapper around 'HKD.HKD'. newtype Nested (b :: Type) (f :: Type -> Type) = Nested (HKD.HKD b f) -type family Nest+type family+ Nest (a :: Type)- (f :: Type -> Type)- = (res :: Type) | res -> a where- Nest (a -> b) f = a -> Nest b f+ (f :: Type -> Type) =+ (res :: Type) | res -> a+ where+ Nest (a -> b) f = a -> Nest b f Nest (HKD.HKD a f) f = Nested a f -- | See documentation for 'HKD.build'@@ -51,15 +55,16 @@ -- someNestedValue -- = nested @User (Just "Joe") (Just 30) -- @-nested- :: forall b f k.- ( HKD.Build b f k- , Coercible (HKD.HKD b f) (Nested b f)- , Coercible k (Nest k f)- )- => Nest k f+nested ::+ forall b f k.+ ( HKD.Build b f k,+ Coercible (HKD.HKD b f) (Nested b f),+ Coercible k (Nest k f)+ ) =>+ Nest k f nested = coerce @k @(Nest k f) hkd- where hkd = HKD.build @b @f @k+ where+ hkd = HKD.build @b @f @k -- | See documentation for 'HKD.construct' --@@ -75,24 +80,26 @@ -- hkdUser -- = nested @User (Just "Joe") (Just 30) -- @-getNested- :: HKD.Construct f b- => Nested b f- -> f b+getNested ::+ HKD.Construct f b =>+ Nested b f ->+ f b getNested (Nested hkd) = HKD.construct hkd -- | Helper for when f ~ Identity-fromNested- :: HKD.Construct Identity b- => Nested b Identity- -> b-fromNested- = runIdentity . getNested+fromNested ::+ HKD.Construct Identity b =>+ Nested b Identity ->+ b+fromNested =+ runIdentity . getNested deriving newtype instance Generic (HKD.HKD b f) => Generic (Nested b f)+ deriving newtype instance JSON.FromJSON (HKD.HKD b f) => JSON.FromJSON (Nested b f) deriving newtype instance B.FunctorB (HKD.HKD b) => B.FunctorB (Nested b)+ deriving newtype instance B.ProductB (HKD.HKD b) => B.ProductB (Nested b) instance (B.TraversableB (HKD.HKD b)) => B.TraversableB (Nested b) where
src/Options/Harg/Operations.hs view
@@ -1,247 +1,263 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Operations- ( execOpt- , execOptDef- , execOptWithCtx- , execOptWithCtxDef- , execCommands- , execCommandsDef- , execCommandsWithCtx- , execCommandsWithCtxDef- ) where -import Data.Functor.Identity (Identity(..))--import qualified Data.Barbie as B-import qualified Options.Applicative as Optparse+module Options.Harg.Operations+ ( execOpt,+ execOptDef,+ execOptWithCtx,+ execOptWithCtxDef,+ execCommands,+ execCommandsDef,+ execCommandsWithCtx,+ execCommandsWithCtxDef,+ )+where -import Options.Harg.Cmdline (mkOptparseParser)-import Options.Harg.Config (mkConfigParser, getConfig)-import Options.Harg.Het.All (All)-import Options.Harg.Het.HList (AssocListF, MapAssocList(..))-import Options.Harg.Het.Prod ((:*)(..))-import Options.Harg.Het.Variant (VariantF)-import Options.Harg.Pretty (ppSourceRunErrors)-import Options.Harg.Sources ( accumSourceResults- , DefaultSources, defaultSources- , HiddenSources, hiddenSources- )-import Options.Harg.Sources.Types (GetSource(..), RunSource(..), SourceRunError)-import Options.Harg.Subcommands (Subcommands(..))-import Options.Harg.Types (HargCtx(..), getCtx, Opt)-import Options.Harg.Util (toDummyOpts, allToDummyOpts, compose)+import qualified Data.Barbie as B+import Data.Functor.Identity (Identity (..))+import qualified Options.Applicative as Optparse+import Options.Harg.Cmdline (mkOptparseParser)+import Options.Harg.Config (getConfig, mkConfigParser)+import Options.Harg.Het.All (All)+import Options.Harg.Het.HList (AssocListF, MapAssocList (..))+import Options.Harg.Het.Prod ((:*) (..))+import Options.Harg.Het.Variant (VariantF)+import Options.Harg.Pretty (ppSourceRunErrors)+import Options.Harg.Sources+ ( DefaultSources,+ HiddenSources,+ accumSourceResults,+ defaultSources,+ hiddenSources,+ )+import Options.Harg.Sources.Types (GetSource (..), RunSource (..), SourceRunError)+import Options.Harg.Subcommands (Subcommands (..))+import Options.Harg.Types (HargCtx (..), Opt, getCtx)+import Options.Harg.Util (allToDummyOpts, compose, toDummyOpts) -- | Run the option parser and combine with values from the specified sources, -- passing the context explicitly.-execOptWithCtx- :: forall c a.- ( B.TraversableB a- , B.ProductB a- , B.TraversableB c- , B.ProductB c- , GetSource c Identity- , RunSource (SourceVal c) a- )- => HargCtx -- ^ Context containing the environment and the cmdline args- -> c Opt -- ^ Source options- -> a Opt -- ^ Target configuration options- -> IO (a Identity)+execOptWithCtx ::+ forall c a.+ ( B.TraversableB a,+ B.ProductB a,+ B.TraversableB c,+ B.ProductB c,+ GetSource c Identity,+ RunSource (SourceVal c) a+ ) =>+ -- | Context containing the environment and the cmdline args+ HargCtx ->+ -- | Source options+ c Opt ->+ -- | Target configuration options+ a Opt ->+ IO (a Identity) execOptWithCtx ctx conf opts = do- let- configParser- = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)- dummyParser- = mkOptparseParser [] (toDummyOpts @String opts)+ let configParser =+ mkConfigParser ctx $ compose Identity (conf :* hiddenSources)+ dummyParser =+ mkOptparseParser [] (toDummyOpts @String opts) config <- getConfig ctx configParser dummyParser sourceVals <- getSource ctx config- let- (errs, sources)- = accumSourceResults- $ runSource sourceVals (compose Identity opts)- optParser- = mkOptparseParser sources (compose Identity opts)- -- parser that includes the configuration options, otherwise parsing- -- will find more options and fail- allParser- = (,) <$> optParser <*> configParser- fst <$> if null errs- then execParser ctx allParser- else failParser allParser errs+ let (errs, sources) =+ accumSourceResults $+ runSource sourceVals (compose Identity opts)+ optParser =+ mkOptparseParser sources (compose Identity opts)+ -- parser that includes the configuration options, otherwise parsing+ -- will find more options and fail+ allParser =+ (,) <$> optParser <*> configParser+ fst+ <$> if null errs+ then execParser ctx allParser+ else failParser allParser errs -- | Run the option parser and combine with values from the specified sources-execOpt- :: forall c a.- ( B.TraversableB a- , B.ProductB a- , B.TraversableB c- , B.ProductB c- , GetSource c Identity- , RunSource (SourceVal c) a- )- => c Opt -- ^ Source options- -> a Opt -- ^ Target configuration options- -> IO (a Identity)+execOpt ::+ forall c a.+ ( B.TraversableB a,+ B.ProductB a,+ B.TraversableB c,+ B.ProductB c,+ GetSource c Identity,+ RunSource (SourceVal c) a+ ) =>+ -- | Source options+ c Opt ->+ -- | Target configuration options+ a Opt ->+ IO (a Identity) execOpt conf opts = do ctx <- getCtx execOptWithCtx ctx conf opts -- | Run the option parser only with default sources (environment variables), -- passing the context explicitly.-execOptWithCtxDef- :: forall a.- ( B.TraversableB a- , B.ProductB a- )- => HargCtx -- ^ Context containing the environment and the cmdline args- -> a Opt -- ^ Target configuration options- -> IO (a Identity)-execOptWithCtxDef ctx- = execOptWithCtx ctx defaultSources+execOptWithCtxDef ::+ forall a.+ ( B.TraversableB a,+ B.ProductB a+ ) =>+ -- | Context containing the environment and the cmdline args+ HargCtx ->+ -- | Target configuration options+ a Opt ->+ IO (a Identity)+execOptWithCtxDef ctx =+ execOptWithCtx ctx defaultSources -- | Run the option parser only with default sources (environment variables)-execOptDef- :: forall a.- ( B.TraversableB a- , B.ProductB a- )- => a Opt -- ^ Target configuration options- -> IO (a Identity)-execOptDef- = execOpt defaultSources+execOptDef ::+ forall a.+ ( B.TraversableB a,+ B.ProductB a+ ) =>+ -- | Target configuration options+ a Opt ->+ IO (a Identity)+execOptDef =+ execOpt defaultSources -- | Run the subcommand parser and combine with values from the specified -- sources, passing the context explicitly.-execCommandsWithCtx- :: forall c ts xs.- ( B.TraversableB (VariantF xs)- , B.TraversableB c- , B.ProductB c- , Subcommands ts xs- , GetSource c Identity- , All (RunSource (SourceVal (c :* HiddenSources))) xs- , All (RunSource ()) xs- , MapAssocList xs- )- => HargCtx -- ^ Context containing the environment and the cmdline args- -> c Opt -- ^ Source options- -> AssocListF ts xs Opt -- ^ Target options associated with subcommands- -> IO (VariantF xs Identity)+execCommandsWithCtx ::+ forall c ts xs.+ ( B.TraversableB (VariantF xs),+ B.TraversableB c,+ B.ProductB c,+ Subcommands ts xs,+ GetSource c Identity,+ All (RunSource (SourceVal (c :* HiddenSources))) xs,+ All (RunSource ()) xs,+ MapAssocList xs+ ) =>+ -- | Context containing the environment and the cmdline args+ HargCtx ->+ -- | Source options+ c Opt ->+ -- | Target options associated with subcommands+ AssocListF ts xs Opt ->+ IO (VariantF xs Identity) execCommandsWithCtx ctx conf opts = do- let- configParser- = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)- (_, dummyCommands)- = mapSubcommand () (allToDummyOpts @String opts)- dummyParser- = Optparse.subparser (mconcat dummyCommands)+ let configParser =+ mkConfigParser ctx $ compose Identity (conf :* hiddenSources)+ (_, dummyCommands) =+ mapSubcommand () (allToDummyOpts @String opts)+ dummyParser =+ Optparse.subparser (mconcat dummyCommands) config <- getConfig ctx configParser dummyParser sourceVals <- getSource ctx config - let- (errs, commands)- = mapSubcommand sourceVals (mapAssocList (compose Identity) opts)- optParser- = Optparse.subparser (mconcat commands)- -- parser that includes the configuration options, otherwise parsing- -- will find more options and fail- allParser- = (,) <$> optParser <*> configParser- fst <$> if null errs- then execParser ctx allParser- else failParser allParser errs+ let (errs, commands) =+ mapSubcommand sourceVals (mapAssocList (compose Identity) opts)+ optParser =+ Optparse.subparser (mconcat commands)+ -- parser that includes the configuration options, otherwise parsing+ -- will find more options and fail+ allParser =+ (,) <$> optParser <*> configParser+ fst+ <$> if null errs+ then execParser ctx allParser+ else failParser allParser errs -- | Run the subcommand parser and combine with values from the specified -- sources-execCommands- :: forall c ts xs.- ( B.TraversableB (VariantF xs)- , B.TraversableB c- , B.ProductB c- , Subcommands ts xs- , GetSource c Identity- , All (RunSource (SourceVal (c :* HiddenSources))) xs- , All (RunSource ()) xs- , MapAssocList xs- )- => c Opt -- ^ Source options- -> AssocListF ts xs Opt -- ^ Target options associated with subcommands- -> IO (VariantF xs Identity)+execCommands ::+ forall c ts xs.+ ( B.TraversableB (VariantF xs),+ B.TraversableB c,+ B.ProductB c,+ Subcommands ts xs,+ GetSource c Identity,+ All (RunSource (SourceVal (c :* HiddenSources))) xs,+ All (RunSource ()) xs,+ MapAssocList xs+ ) =>+ -- | Source options+ c Opt ->+ -- | Target options associated with subcommands+ AssocListF ts xs Opt ->+ IO (VariantF xs Identity) execCommands conf opts = do ctx <- getCtx execCommandsWithCtx ctx conf opts -- | Run the subcommand parser only with default sources (environment -- variables), passing the context explicitly.-execCommandsWithCtxDef- :: forall ts xs.- ( B.TraversableB (VariantF xs)- , Subcommands ts xs- , All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs- , All (RunSource ()) xs- , MapAssocList xs- )- => HargCtx -- ^ Context containing the environment and the cmdline args- -> AssocListF ts xs Opt -- ^ Target options associated with subcommands- -> IO (VariantF xs Identity)-execCommandsWithCtxDef ctx- = execCommandsWithCtx ctx defaultSources+execCommandsWithCtxDef ::+ forall ts xs.+ ( B.TraversableB (VariantF xs),+ Subcommands ts xs,+ All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs,+ All (RunSource ()) xs,+ MapAssocList xs+ ) =>+ -- | Context containing the environment and the cmdline args+ HargCtx ->+ -- | Target options associated with subcommands+ AssocListF ts xs Opt ->+ IO (VariantF xs Identity)+execCommandsWithCtxDef ctx =+ execCommandsWithCtx ctx defaultSources -- | Run the subcommand parser only with default sources (environment -- variables)-execCommandsDef- :: forall ts xs.- ( B.TraversableB (VariantF xs)- , Subcommands ts xs- , All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs- , All (RunSource ()) xs- , MapAssocList xs- )- => AssocListF ts xs Opt -- ^ Target options associated with subcommands- -> IO (VariantF xs Identity)-execCommandsDef- = execCommands defaultSources+execCommandsDef ::+ forall ts xs.+ ( B.TraversableB (VariantF xs),+ Subcommands ts xs,+ All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs,+ All (RunSource ()) xs,+ MapAssocList xs+ ) =>+ -- | Target options associated with subcommands+ AssocListF ts xs Opt ->+ IO (VariantF xs Identity)+execCommandsDef =+ execCommands defaultSources -- | Run the optparse-applicative parser, printing accumulated errors. Errors -- are printed as warnings if the parser succeeds.-execParser- :: HargCtx- -> Optparse.Parser a- -> IO a-execParser HargCtx{..} parser- = Optparse.handleParseResult (execParserPure _hcArgs parser)+execParser ::+ HargCtx ->+ Optparse.Parser a ->+ IO a+execParser HargCtx {..} parser =+ Optparse.handleParseResult (execParserPure _hcArgs parser) -failParser- :: Optparse.Parser a- -> [SourceRunError]- -> IO a-failParser parser errs- = Optparse.handleParseResult (Optparse.Failure failure)+failParser ::+ Optparse.Parser a ->+ [SourceRunError] ->+ IO a+failParser parser errs =+ Optparse.handleParseResult (Optparse.Failure failure) where- failure- = Optparse.parserFailure- Optparse.defaultPrefs- parserInfo- (Optparse.ErrorMsg errStr)- []- parserInfo- = Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions- errStr- = ppSourceRunErrors errs+ failure =+ Optparse.parserFailure+ Optparse.defaultPrefs+ parserInfo+ (Optparse.ErrorMsg errStr)+ []+ parserInfo =+ Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions+ errStr =+ ppSourceRunErrors errs -- | Run the optparse-applicative parser and return the -- 'Optparse.ParserResult'-execParserPure- :: [String]- -> Optparse.Parser a- -> Optparse.ParserResult a-execParserPure args parser- = let- parserInfo- = Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions- in Optparse.execParserPure Optparse.defaultPrefs parserInfo args+execParserPure ::+ [String] ->+ Optparse.Parser a ->+ Optparse.ParserResult a+execParserPure args parser =+ Optparse.execParserPure Optparse.defaultPrefs parserInfo args+ where+ parserInfo =+ Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions
src/Options/Harg/Pretty.hs view
@@ -1,57 +1,55 @@ module Options.Harg.Pretty- ( ppHelp- , ppSourceRunErrors- ) where--import Control.Applicative ((<|>))-import Data.List (intercalate)-import Data.Maybe (fromMaybe)+ ( ppHelp,+ ppSourceRunErrors,+ )+where +import Control.Applicative ((<|>))+import Data.List (intercalate)+import Data.Maybe (fromMaybe) import Options.Harg.Sources.Types import Options.Harg.Types --ppHelp- :: Opt a- -> Maybe String-ppHelp Opt{..}- = (<> ppEnvVar _optEnvVar) <$> _optHelp+ppHelp ::+ Opt a ->+ Maybe String+ppHelp Opt {..} =+ (<> ppEnvVar _optEnvVar) <$> _optHelp -ppSourceRunErrors- :: [SourceRunError]- -> String-ppSourceRunErrors- = intercalate "\n\n"- . map ppSourceRunError+ppSourceRunErrors ::+ [SourceRunError] ->+ String+ppSourceRunErrors =+ intercalate "\n\n"+ . map ppSourceRunError where ppSourceRunError :: SourceRunError -> String- ppSourceRunError (SourceRunError Nothing src desc)- = "error: "- <> desc- <> "\n\t"- <> ppSource src-- ppSourceRunError (SourceRunError (Just (SomeOpt opt)) src desc)- = "option "- <> optId opt- <> ": "- <> desc- <> "\n\t"- <> ppSource src- <> ppEnvVar (_optEnvVar opt)+ ppSourceRunError (SourceRunError Nothing src desc) =+ "error: "+ <> desc+ <> "\n\t"+ <> ppSource src+ ppSourceRunError (SourceRunError (Just (SomeOpt opt)) src desc) =+ "option "+ <> optId opt+ <> ": "+ <> desc+ <> "\n\t"+ <> ppSource src+ <> ppEnvVar (_optEnvVar opt) - optId Opt{..}- = fromMaybe "<no name available>"- $ _optLong <|> (pure <$> _optShort) <|> _optMetavar+ optId Opt {..} =+ fromMaybe "<no name available>" $+ _optLong <|> (pure <$> _optShort) <|> _optMetavar -ppSource- :: String- -> String-ppSource s- = " (source: " <> s <> ")"+ppSource ::+ String ->+ String+ppSource s =+ " (source: " <> s <> ")" -ppEnvVar- :: Maybe String- -> String-ppEnvVar- = maybe "" $ \s -> " (env var: " <> s <> ")"+ppEnvVar ::+ Maybe String ->+ String+ppEnvVar =+ maybe "" $ \s -> " (env var: " <> s <> ")"
src/Options/Harg/Single.hs view
@@ -1,22 +1,22 @@-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Single- ( Single (..)- , single- , fromSingle- ) where--import Data.Functor.Identity (Identity(..))-import qualified Data.Functor.Product as P-import Data.Kind (Type)-import GHC.Generics (Generic)+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-} -import qualified Data.Aeson as JSON-import qualified Data.Barbie as B+module Options.Harg.Single+ ( Single (..),+ single,+ fromSingle,+ )+where +import qualified Data.Aeson as JSON+import qualified Data.Barbie as B+import Data.Functor.Identity (Identity (..))+import qualified Data.Functor.Product as P+import Data.Kind (Type)+import GHC.Generics (Generic) -- | @Single a f@ is a newtype around @f a@, which allows mixing non-nested -- with nested values when creating configuration parsers, using@@ -33,10 +33,9 @@ -- where -- ... -- @-newtype Single (a :: Type) (f :: Type -> Type)- = Single- { getSingle :: f a- }+newtype Single (a :: Type) (f :: Type -> Type) = Single+ { getSingle :: f a+ } -- | Wrap a value into a 'Single'. single :: f a -> Single a f@@ -47,7 +46,9 @@ fromSingle = runIdentity . getSingle deriving instance (Show a, Show (f a)) => Show (Single a f)+ deriving newtype instance Generic (f a) => Generic (Single a f)+ deriving newtype instance JSON.FromJSON (f a) => JSON.FromJSON (Single a f) instance B.FunctorB (Single a) where
src/Options/Harg/Sources.hs view
@@ -1,50 +1,48 @@ module Options.Harg.Sources- ( accumSourceResults- , HiddenSources- , hiddenSources- , DefaultSources- , defaultSources- ) where--import Data.Foldable (foldr')-import Data.Functor.Compose (Compose(..))--import qualified Data.Barbie as B--import Options.Harg.Sources.DefaultStr (DefaultStrSource(..))-import Options.Harg.Sources.Env (EnvSource(..))-import Options.Harg.Sources.Types+ ( accumSourceResults,+ HiddenSources,+ hiddenSources,+ DefaultSources,+ defaultSources,+ )+where +import qualified Data.Barbie as B+import Data.Foldable (foldr')+import Data.Functor.Compose (Compose (..))+import Options.Harg.Sources.DefaultStr (DefaultStrSource (..))+import Options.Harg.Sources.Env (EnvSource (..))+import Options.Harg.Sources.Types -- | Accumulate all the successful source results and return them, -- along with a list of errors.-accumSourceResults- :: forall a f.- B.TraversableB a- => [Either SourceRunError (a (Compose SourceRunResult f))]- -> ([SourceRunError], [a (Compose Maybe f)])-accumSourceResults- = foldr' accumResult ([], [])+accumSourceResults ::+ forall a f.+ B.TraversableB a =>+ [Either SourceRunError (a (Compose SourceRunResult f))] ->+ ([SourceRunError], [a (Compose Maybe f)])+accumSourceResults =+ foldr' accumResult ([], []) where- accumResult- :: Either SourceRunError (a (Compose SourceRunResult f))- -> ([SourceRunError], [a (Compose Maybe f)])- -> ([SourceRunError], [a (Compose Maybe f)])- accumResult res (e, a)- = case res of- Left sre -> (sre : e, a)- Right res' ->- case B.btraverse go res' of- (e', a') -> (e' <> e, a' : a)- go- :: Compose SourceRunResult f x- -> ([SourceRunError], Compose Maybe f x)- go x- = case getCompose x of- OptParsed a- -> ([], Compose (Just a))- OptNotFound- -> ([], Compose Nothing)+ accumResult ::+ Either SourceRunError (a (Compose SourceRunResult f)) ->+ ([SourceRunError], [a (Compose Maybe f)]) ->+ ([SourceRunError], [a (Compose Maybe f)])+ accumResult res (e, a) =+ case res of+ Left sre -> (sre : e, a)+ Right res' ->+ case B.btraverse go res' of+ (e', a') -> (e' <> e, a' : a)+ go ::+ Compose SourceRunResult f x ->+ ([SourceRunError], Compose Maybe f x)+ go x =+ case getCompose x of+ OptParsed a ->+ ([], Compose (Just a))+ OptNotFound ->+ ([], Compose Nothing) type HiddenSources = DefaultStrSource
src/Options/Harg/Sources/DefaultStr.hs view
@@ -1,19 +1,18 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}-module Options.Harg.Sources.DefaultStr- ( DefaultStrSource (..)- ) where--import Data.Functor.Compose (Compose (..))-import Data.Kind (Type)-import GHC.Generics (Generic)--import qualified Data.Barbie as B+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-} -import Options.Harg.Sources.Types-import Options.Harg.Types+module Options.Harg.Sources.DefaultStr+ ( DefaultStrSource (..),+ )+where +import qualified Data.Barbie as B+import Data.Functor.Compose (Compose (..))+import Data.Kind (Type)+import GHC.Generics (Generic)+import Options.Harg.Sources.Types+import Options.Harg.Types -- | Source that enables a parser to read options from defaults that are provided -- as strings (unparsed).@@ -26,39 +25,41 @@ instance GetSource DefaultStrSource f where type SourceVal DefaultStrSource = DefaultStrSourceVal- getSource HargCtx{..} _- = pure DefaultStrSourceVal+ getSource HargCtx {..} _ =+ pure DefaultStrSourceVal instance- ( B.FunctorB a- , B.TraversableB a- ) => RunSource DefaultStrSourceVal a where- runSource DefaultStrSourceVal opt- = [runDefaultStrSource opt]+ ( B.FunctorB a,+ B.TraversableB a+ ) =>+ RunSource DefaultStrSourceVal a+ where+ runSource DefaultStrSourceVal opt =+ [runDefaultStrSource opt] -- TODO: this looks very similar to EnvSource, perhaps unify-runDefaultStrSource- :: forall a f.- ( B.FunctorB a- , B.TraversableB a- , Applicative f- )- => a (Compose Opt f)- -> Either SourceRunError (a (Compose SourceRunResult f))-runDefaultStrSource- = B.btraverse go+runDefaultStrSource ::+ forall a f.+ ( B.FunctorB a,+ B.TraversableB a,+ Applicative f+ ) =>+ a (Compose Opt f) ->+ Either SourceRunError (a (Compose SourceRunResult f))+runDefaultStrSource =+ B.btraverse go where- go- :: Compose Opt f x- -> Either SourceRunError (Compose SourceRunResult f x)- go (Compose opt@Opt{..})- = maybe toNotFound parse _optDefaultStr+ go ::+ Compose Opt f x ->+ Either SourceRunError (Compose SourceRunResult f x)+ go (Compose opt@Opt {..}) =+ maybe toNotFound parse _optDefaultStr where- parse- = either toErr toParsed . _optReader- toNotFound- = Right $ Compose $ pure <$> OptNotFound- toErr- = Left . sourceRunError opt "DefaultStrSource"- toParsed- = Right . Compose . OptParsed+ parse =+ either toErr toParsed . _optReader+ toNotFound =+ Right $ Compose $ pure <$> OptNotFound+ toErr =+ Left . sourceRunError opt "DefaultStrSource"+ toParsed =+ Right . Compose . OptParsed
src/Options/Harg/Sources/Env.hs view
@@ -1,21 +1,20 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}-module Options.Harg.Sources.Env- ( EnvSource (..)- , EnvSourceVal (..)- ) where--import Data.Functor.Compose (Compose (..))-import Data.Kind (Type)-import Data.List (find)-import GHC.Generics (Generic)--import qualified Data.Barbie as B+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-} -import Options.Harg.Sources.Types-import Options.Harg.Types+module Options.Harg.Sources.Env+ ( EnvSource (..),+ EnvSourceVal (..),+ )+where +import qualified Data.Barbie as B+import Data.Functor.Compose (Compose (..))+import Data.Kind (Type)+import Data.List (find)+import GHC.Generics (Generic)+import Options.Harg.Sources.Types+import Options.Harg.Types -- | Source that enables a parser to read options from environment variables. data EnvSource (f :: Type -> Type) = EnvSource@@ -27,47 +26,49 @@ instance GetSource EnvSource f where type SourceVal EnvSource = EnvSourceVal- getSource HargCtx{..} _- = pure (EnvSourceVal _hcEnv)+ getSource HargCtx {..} _ =+ pure (EnvSourceVal _hcEnv) instance- ( B.FunctorB a- , B.TraversableB a- ) => RunSource EnvSourceVal a where- runSource (EnvSourceVal e) opt- = [runEnvVarSource e opt]+ ( B.FunctorB a,+ B.TraversableB a+ ) =>+ RunSource EnvSourceVal a+ where+ runSource (EnvSourceVal e) opt =+ [runEnvVarSource e opt] -- | Try to get a value from the environment variable association list.-lookupEnv- :: Environment- -> String- -> Maybe String-lookupEnv env x- = snd <$> find ((== x) . fst) env+lookupEnv ::+ Environment ->+ String ->+ Maybe String+lookupEnv env x =+ snd <$> find ((== x) . fst) env -runEnvVarSource- :: forall a f.- ( B.FunctorB a- , B.TraversableB a- , Applicative f- )- => Environment- -> a (Compose Opt f)- -> Either SourceRunError (a (Compose SourceRunResult f))-runEnvVarSource env- = B.btraverse go+runEnvVarSource ::+ forall a f.+ ( B.FunctorB a,+ B.TraversableB a,+ Applicative f+ ) =>+ Environment ->+ a (Compose Opt f) ->+ Either SourceRunError (a (Compose SourceRunResult f))+runEnvVarSource env =+ B.btraverse go where- go- :: Compose Opt f x- -> Either SourceRunError (Compose SourceRunResult f x)- go (Compose opt@Opt{..})- = maybe toNotFound (parse . lookupEnv env) _optEnvVar+ go ::+ Compose Opt f x ->+ Either SourceRunError (Compose SourceRunResult f x)+ go (Compose opt@Opt {..}) =+ maybe toNotFound (parse . lookupEnv env) _optEnvVar where- parse- = maybe toNotFound (either toErr toParsed . _optReader)- toNotFound- = Right $ Compose $ pure <$> OptNotFound- toErr- = Left . sourceRunError opt "EnvSource"- toParsed- = Right . Compose . OptParsed+ parse =+ maybe toNotFound (either toErr toParsed . _optReader)+ toNotFound =+ Right $ Compose $ pure <$> OptNotFound+ toErr =+ Left . sourceRunError opt "EnvSource"+ toParsed =+ Right . Compose . OptParsed
src/Options/Harg/Sources/JSON.hs view
@@ -1,22 +1,22 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Sources.JSON- ( JSONSource (..)- ) where -import qualified Data.ByteString.Lazy as LBS-import Data.Functor.Compose (Compose (..))-import Data.Functor.Identity (Identity(..))-import GHC.Generics (Generic)--import qualified Data.Aeson as JSON-import qualified Data.Barbie as B+module Options.Harg.Sources.JSON+ ( JSONSource (..),+ )+where -import Options.Harg.Sources.Types-import Options.Harg.Types-import Options.Harg.Util (readFileLBS)+import qualified Data.Aeson as JSON+import qualified Data.Barbie as B+import qualified Data.ByteString.Lazy as LBS+import Data.Functor.Compose (Compose (..))+import Data.Functor.Identity (Identity (..))+import GHC.Generics (Generic)+import Options.Harg.Sources.Types+import Options.Harg.Types+import Options.Harg.Util (readFileLBS) -- | Source that enables a parser to read options from a JSON file. newtype JSONSource f = JSONSource (f ConfigFile)@@ -31,42 +31,44 @@ instance GetSource JSONSource Identity where type SourceVal JSONSource = JSONSourceVal- getSource _ctx (JSONSource (Identity (ConfigFile path)))- = JSONSourceVal <$> readFileLBS path- getSource _ctx (JSONSource (Identity NoConfigFile))- = pure JSONSourceNotRequired+ getSource _ctx (JSONSource (Identity (ConfigFile path))) =+ JSONSourceVal <$> readFileLBS path+ getSource _ctx (JSONSource (Identity NoConfigFile)) =+ pure JSONSourceNotRequired instance- ( JSON.FromJSON (a Maybe)- , B.FunctorB a- ) => RunSource JSONSourceVal a where- runSource (JSONSourceVal j) opt- = [runJSONSource j opt]- runSource JSONSourceNotRequired _- = []+ ( JSON.FromJSON (a Maybe),+ B.FunctorB a+ ) =>+ RunSource JSONSourceVal a+ where+ runSource (JSONSourceVal j) opt =+ [runJSONSource j opt]+ runSource JSONSourceNotRequired _ =+ [] -runJSONSource- :: forall a f.- ( B.FunctorB a- , JSON.FromJSON (a Maybe)- , Applicative f- )- => LBS.ByteString- -> a (Compose Opt f)- -> Either SourceRunError (a (Compose SourceRunResult f))-runJSONSource json _opt- = case res of- Right v -> Right $ B.bmap toSuccess v- Left exc -> Left $ toError exc+runJSONSource ::+ forall a f.+ ( B.FunctorB a,+ JSON.FromJSON (a Maybe),+ Applicative f+ ) =>+ LBS.ByteString ->+ a (Compose Opt f) ->+ Either SourceRunError (a (Compose SourceRunResult f))+runJSONSource json _opt =+ case res of+ Right v -> Right $ B.bmap toSuccess v+ Left exc -> Left $ toError exc where res :: Either String (a Maybe)- res- = JSON.eitherDecode json+ res =+ JSON.eitherDecode json toSuccess :: Maybe x -> Compose SourceRunResult f x- toSuccess mx- = Compose $ pure <$> maybe OptNotFound OptParsed mx+ toSuccess mx =+ Compose $ pure <$> maybe OptNotFound OptParsed mx toError :: String -> SourceRunError- toError- = SourceRunError Nothing "JSONSource"+ toError =+ SourceRunError Nothing "JSONSource"
src/Options/Harg/Sources/NoSource.hs view
@@ -1,18 +1,17 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}-module Options.Harg.Sources.NoSource- ( NoSource- , noSources- ) where--import Data.Kind (Type)-import GHC.Generics (Generic)--import qualified Data.Barbie as B+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-} -import Options.Harg.Sources.Types+module Options.Harg.Sources.NoSource+ ( NoSource,+ noSources,+ )+where +import qualified Data.Barbie as B+import Data.Kind (Type)+import GHC.Generics (Generic)+import Options.Harg.Sources.Types -- | Throwaway type whose 'GetSource' instance returns no value. data NoSource (f :: Type -> Type) = NoSource
src/Options/Harg/Sources/Types.hs view
@@ -1,84 +1,92 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Sources.Types- ( GetSource (..)- , RunSource (..)- , ConfigFile (..)- , SourceRunResult (..)- , SourceRunError (..)- , sourceRunError- ) where -import Data.Functor.Compose (Compose(..))-import Data.Kind (Type)-import Data.String (IsString(..))+module Options.Harg.Sources.Types+ ( GetSource (..),+ RunSource (..),+ ConfigFile (..),+ SourceRunResult (..),+ SourceRunError (..),+ sourceRunError,+ )+where -import Options.Harg.Het.Prod ((:*)(..))+import Data.Functor.Compose (Compose (..))+import Data.Kind (Type)+import Data.String (IsString (..))+import Options.Harg.Het.Prod ((:*) (..)) import Options.Harg.Types - -- | Holds errors that occur when running a source. data SourceRunResult a- = OptNotFound -- ^ Source doesn't include the option- | OptParsed a -- ^ Successful parsing- deriving Functor+ = -- | Source doesn't include the option+ OptNotFound+ | -- | Successful parsing+ OptParsed a+ deriving (Functor) -data SourceRunError- = SourceRunError- { _sreOpt :: Maybe SomeOpt- , _sreSourceName :: String- , _sreError :: String- }+data SourceRunError = SourceRunError+ { _sreOpt :: Maybe SomeOpt,+ _sreSourceName :: String,+ _sreError :: String+ } -- | Create a 'SourceRunError' by existentially wrapping an option in 'SomeOpt'.-sourceRunError- :: forall a.- Opt a- -> String- -> String- -> SourceRunError-sourceRunError- = SourceRunError . Just . SomeOpt+sourceRunError ::+ forall a.+ Opt a ->+ String ->+ String ->+ SourceRunError+sourceRunError =+ SourceRunError . Just . SomeOpt -- | This class enables a type that describes a source to fetch the source -- contents, potentially producing side effects (e.g. reading a file).-class GetSource+class+ GetSource (c :: (Type -> Type) -> Type)- (f :: (Type -> Type)) where+ (f :: (Type -> Type))+ where -- | The type that will be returned when the source is read. type SourceVal c :: Type+ getSource :: HargCtx -> c f -> IO (SourceVal c) instance- ( GetSource l f- , GetSource r f- ) => GetSource (l :* r) f where+ ( GetSource l f,+ GetSource r f+ ) =>+ GetSource (l :* r) f+ where type SourceVal (l :* r) = (SourceVal l, SourceVal r)- getSource ctx (l :* r)- = (,) <$> getSource ctx l <*> getSource ctx r+ getSource ctx (l :* r) =+ (,) <$> getSource ctx l <*> getSource ctx r -- | This class is used to run the result of running 'getSource' on the -- configuration options. In order for it to work, all types used in the -- source configuration need to have a 'GetSource' instance, and their -- associated 'SourceVal' types need to have a 'RunSource' instance. class RunSource s a where- runSource- :: Applicative f- => s- -> a (Compose Opt f)- -> [Either SourceRunError (a (Compose SourceRunResult f))]+ runSource ::+ Applicative f =>+ s ->+ a (Compose Opt f) ->+ [Either SourceRunError (a (Compose SourceRunResult f))] instance- ( RunSource l a- , RunSource r a- ) => RunSource (l, r) a where- runSource (l, r) opt- = runSource l opt ++ runSource r opt+ ( RunSource l a,+ RunSource r a+ ) =>+ RunSource (l, r) a+ where+ runSource (l, r) opt =+ runSource l opt ++ runSource r opt instance RunSource () a where- runSource () _- = []+ runSource () _ =+ [] -- | This type describes configuration files, for use with e.g. the JSON -- source. The reason to not use 'FilePath' directly is that the user might@@ -110,7 +118,6 @@ -- . defaultVal NoConfigFile -- ) -- @--- data ConfigFile = ConfigFile FilePath | NoConfigFile
src/Options/Harg/Sources/YAML.hs view
@@ -1,24 +1,23 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Sources.YAML- ( YAMLSource (..)- ) where -import Control.Exception (displayException)-import qualified Data.ByteString as BS-import Data.Functor.Compose (Compose (..))-import Data.Functor.Identity (Identity(..))-import GHC.Generics (Generic)--import qualified Data.Barbie as B-import qualified Data.Yaml as YAML--import Options.Harg.Sources.Types-import Options.Harg.Types-import Options.Harg.Util (readFileBS)+module Options.Harg.Sources.YAML+ ( YAMLSource (..),+ )+where +import Control.Exception (displayException)+import qualified Data.Barbie as B+import qualified Data.ByteString as BS+import Data.Functor.Compose (Compose (..))+import Data.Functor.Identity (Identity (..))+import qualified Data.Yaml as YAML+import GHC.Generics (Generic)+import Options.Harg.Sources.Types+import Options.Harg.Types+import Options.Harg.Util (readFileBS) -- | Source that enables a parser to read options from a YAML file. newtype YAMLSource f = YAMLSource (f ConfigFile)@@ -33,42 +32,44 @@ instance GetSource YAMLSource Identity where type SourceVal YAMLSource = YAMLSourceVal- getSource _ctx (YAMLSource (Identity (ConfigFile path)))- = YAMLSourceVal <$> readFileBS path- getSource _ctx (YAMLSource (Identity NoConfigFile))- = pure YAMLSourceNotRequired+ getSource _ctx (YAMLSource (Identity (ConfigFile path))) =+ YAMLSourceVal <$> readFileBS path+ getSource _ctx (YAMLSource (Identity NoConfigFile)) =+ pure YAMLSourceNotRequired instance- ( YAML.FromJSON (a Maybe)- , B.FunctorB a- ) => RunSource YAMLSourceVal a where- runSource (YAMLSourceVal j) opt- = [runYAMLSource j opt]- runSource YAMLSourceNotRequired _- = []+ ( YAML.FromJSON (a Maybe),+ B.FunctorB a+ ) =>+ RunSource YAMLSourceVal a+ where+ runSource (YAMLSourceVal j) opt =+ [runYAMLSource j opt]+ runSource YAMLSourceNotRequired _ =+ [] -runYAMLSource- :: forall a f.- ( B.FunctorB a- , YAML.FromJSON (a Maybe)- , Applicative f- )- => BS.ByteString- -> a (Compose Opt f)- -> Either SourceRunError (a (Compose SourceRunResult f))-runYAMLSource yaml _opt- = case res of- Right v -> Right $ B.bmap toSuccess v- Left exc -> Left $ toError exc+runYAMLSource ::+ forall a f.+ ( B.FunctorB a,+ YAML.FromJSON (a Maybe),+ Applicative f+ ) =>+ BS.ByteString ->+ a (Compose Opt f) ->+ Either SourceRunError (a (Compose SourceRunResult f))+runYAMLSource yaml _opt =+ case res of+ Right v -> Right $ B.bmap toSuccess v+ Left exc -> Left $ toError exc where res :: Either YAML.ParseException (a Maybe)- res- = YAML.decodeEither' yaml+ res =+ YAML.decodeEither' yaml toSuccess :: Maybe x -> Compose SourceRunResult f x- toSuccess mx- = Compose $ pure <$> maybe OptNotFound OptParsed mx+ toSuccess mx =+ Compose $ pure <$> maybe OptNotFound OptParsed mx toError :: YAML.ParseException -> SourceRunError- toError exc- = SourceRunError Nothing "YAMLSource" (displayException exc)+ toError exc =+ SourceRunError Nothing "YAMLSource" (displayException exc)
src/Options/Harg/Subcommands.hs view
@@ -1,26 +1,26 @@-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableInstances #-}-module Options.Harg.Subcommands- ( Subcommands (..)- ) where -import Data.Functor.Compose (Compose (..))-import Data.Kind (Type)-import Data.Proxy (Proxy (..))-import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)--import qualified Data.Barbie as B-import qualified Options.Applicative as Optparse+module Options.Harg.Subcommands+ ( Subcommands (..),+ )+where -import Options.Harg.Cmdline (mkOptparseParser)-import Options.Harg.Het.All (All)-import Options.Harg.Het.HList (AssocListF(..))-import Options.Harg.Het.Nat-import Options.Harg.Het.Proofs (type (++), Proof(..), hgcastWith)-import Options.Harg.Het.Variant (VariantF, InjectPosF(..))-import Options.Harg.Sources (accumSourceResults)-import Options.Harg.Sources.Types-import Options.Harg.Types+import qualified Data.Barbie as B+import Data.Functor.Compose (Compose (..))+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+import qualified Options.Applicative as Optparse+import Options.Harg.Cmdline (mkOptparseParser)+import Options.Harg.Het.All (All)+import Options.Harg.Het.HList (AssocListF (..))+import Options.Harg.Het.Nat+import Options.Harg.Het.Proofs (Proof (..), hgcastWith, type (++))+import Options.Harg.Het.Variant (InjectPosF (..), VariantF)+import Options.Harg.Sources (accumSourceResults)+import Options.Harg.Sources.Types+import Options.Harg.Types -- | This class can be used with an 'AssocList'. It returns the appropriate -- list of 'Optparse.CommandFields' in order to create a subcommand parser.@@ -52,36 +52,38 @@ -- Should return @VariantF '[RunConfig, TestConfig] Identity@. In order to do -- that, it will inject @RunConfig@ based on its position (0) using @HereF@, -- and @TestConfig@ using @ThereF . HereF@ because its position is 1.----class Subcommands+class+ Subcommands (ts :: [Symbol])- (xs :: [(Type -> Type) -> Type]) where- mapSubcommand- :: ( All (RunSource s) xs- , Applicative f- )- => s- -> AssocListF ts xs (Compose Opt f)- -> ([SourceRunError], [Optparse.Mod Optparse.CommandFields (VariantF xs f)])+ (xs :: [(Type -> Type) -> Type])+ where+ mapSubcommand ::+ ( All (RunSource s) xs,+ Applicative f+ ) =>+ s ->+ AssocListF ts xs (Compose Opt f) ->+ ([SourceRunError], [Optparse.Mod Optparse.CommandFields (VariantF xs f)]) instance ExplSubcommands Z ts xs '[] => Subcommands ts xs where mapSubcommand = explMapSubcommand @Z @ts @xs @'[] SZ - -- | More general version of 'Subcommands'.-class ExplSubcommands+class+ ExplSubcommands (n :: Nat) (ts :: [Symbol]) (xs :: [(Type -> Type) -> Type])- (acc :: [(Type -> Type) -> Type]) where- explMapSubcommand- :: ( All (RunSource s) xs- , Applicative f- )- => SNat n- -> s- -> AssocListF ts xs (Compose Opt f)- -> ([SourceRunError], [Optparse.Mod Optparse.CommandFields (VariantF (acc ++ xs) f)])+ (acc :: [(Type -> Type) -> Type])+ where+ explMapSubcommand ::+ ( All (RunSource s) xs,+ Applicative f+ ) =>+ SNat n ->+ s ->+ AssocListF ts xs (Compose Opt f) ->+ ([SourceRunError], [Optparse.Mod Optparse.CommandFields (VariantF (acc ++ xs) f)]) instance ExplSubcommands n '[] '[] acc where explMapSubcommand _ _ _ = ([], [])@@ -89,36 +91,41 @@ -- ok wait -- hear me out: instance- ( ExplSubcommands (S n) ts xs (as ++ '[x])- -- get the correct injection into the variant by position- , InjectPosF n x (as ++ (x ': xs))- , B.TraversableB x- , B.ProductB x- , KnownSymbol t- -- prove that xs ++ (y : ys) ~ (xs ++ [y]) ++ ys- , Proof as x xs- ) => ExplSubcommands n (t ': ts) (x ': xs) as where-- explMapSubcommand n srcs (ACons opt opts)- = (thisErr ++ restErr, sc : rest)+ ( ExplSubcommands (S n) ts xs (as ++ '[x]),+ -- get the correct injection into the variant by position+ InjectPosF n x (as ++ (x ': xs)),+ B.TraversableB x,+ B.ProductB x,+ KnownSymbol t,+ -- prove that xs ++ (y : ys) ~ (xs ++ [y]) ++ ys+ Proof as x xs+ ) =>+ ExplSubcommands n (t ': ts) (x ': xs) as+ where+ explMapSubcommand n srcs (ACons opt opts) =+ (thisErr ++ restErr, sc : rest) where- (thisErr, sc)- = subcommand- (restErr, rest)- = hgcastWith (proof @as @x @xs)- $ explMapSubcommand- @(S n) @ts @xs @(as ++ '[x])- (SS n) srcs opts- subcommand- = let- (errs, src)- = accumSourceResults $ runSource srcs opt- parser- = mkOptparseParser src opt- tag- = symbolVal (Proxy :: Proxy t)- cmd- = Optparse.command tag- $ injectPosF n+ (thisErr, sc) =+ subcommand+ (restErr, rest) =+ hgcastWith (proof @as @x @xs) $+ explMapSubcommand+ @(S n)+ @ts+ @xs+ @(as ++ '[x])+ (SS n)+ srcs+ opts+ subcommand =+ let (errs, src) =+ accumSourceResults $ runSource srcs opt+ parser =+ mkOptparseParser src opt+ tag =+ symbolVal (Proxy :: Proxy t)+ cmd =+ Optparse.command tag $+ injectPosF n <$> Optparse.info (Optparse.helper <*> parser) mempty- in (errs, cmd)+ in (errs, cmd)
src/Options/Harg/Types.hs view
@@ -1,47 +1,58 @@ {-# LANGUAGE DeriveFunctor #-}+ module Options.Harg.Types- ( Opt (..)- , OptionOpt (..)- , FlagOpt (..)- , ArgumentOpt (..)- , OptAttr (..)- , OptType (..)- , SomeOpt (..)- , OptReader- , HargCtx (..)- , Environment- , getCtx- , ctxFromArgs- , ctxFromEnv- , pureCtx- ) where+ ( Opt (..),+ OptionOpt (..),+ FlagOpt (..),+ ArgumentOpt (..),+ OptAttr (..),+ OptType (..),+ SomeOpt (..),+ OptReader,+ HargCtx (..),+ Environment,+ getCtx,+ ctxFromArgs,+ ctxFromEnv,+ pureCtx,+ )+where import System.Environment (getArgs, getEnvironment) type OptReader a = String -> Either String a -- | The basic option type-data Opt a- = Opt- { _optLong :: Maybe String -- ^ Modifier for long options (e.g. @--user@)- , _optShort :: Maybe Char -- ^ Modifier for short options (e.g. @-u@)- , _optHelp :: Maybe String -- ^ Option help to be shown when invoked- -- with @--help/-h@ or in case of error- , _optMetavar :: Maybe String -- ^ Metavar to be shown in the help description- , _optEnvVar :: Maybe String -- ^ Environment variable for use with 'EnvSource'- , _optDefaultVal :: Maybe a -- ^ Default value- , _optDefaultStr :: Maybe String -- ^ Default value as string (unparsed)- , _optReader :: OptReader a -- ^ Option parser- , _optType :: OptType a -- ^ Option type- }- deriving Functor+data Opt a = Opt+ { -- | Modifier for long options (e.g. @--user@)+ _optLong :: Maybe String,+ -- | Modifier for short options (e.g. @-u@)+ _optShort :: Maybe Char,+ -- | Option help to be shown when invoked+ -- with @--help/-h@ or in case of error+ _optHelp :: Maybe String,+ -- | Metavar to be shown in the help description+ _optMetavar :: Maybe String,+ -- | Environment variable for use with 'EnvSource'+ _optEnvVar :: Maybe String,+ -- | Default value+ _optDefaultVal :: Maybe a,+ -- | Default value as string (unparsed)+ _optDefaultStr :: Maybe String,+ -- | Option parser+ _optReader :: OptReader a,+ -- | Option type+ _optType :: OptType a+ }+ deriving (Functor) -- | Option types data OptType a = OptionOptType- | FlagOptType a -- ^ @a@ is the active value for the flag parser+ | -- | @a@ is the active value for the flag parser+ FlagOptType a | ArgumentOptType- deriving Functor+ deriving (Functor) data OptAttr = OptDefault@@ -50,42 +61,39 @@ -- * Intermediate option types -- | Option for flags with arguments. Corresponds to 'Options.Applicative.option'.-data OptionOpt (attr :: [OptAttr]) a- = OptionOpt- { _oLong :: Maybe String- , _oShort :: Maybe Char- , _oHelp :: Maybe String- , _oMetavar :: Maybe String- , _oEnvVar :: Maybe String- , _oDefaultVal :: Maybe a- , _oDefaultStr :: Maybe String- , _oReader :: OptReader a- }+data OptionOpt (attr :: [OptAttr]) a = OptionOpt+ { _oLong :: Maybe String,+ _oShort :: Maybe Char,+ _oHelp :: Maybe String,+ _oMetavar :: Maybe String,+ _oEnvVar :: Maybe String,+ _oDefaultVal :: Maybe a,+ _oDefaultStr :: Maybe String,+ _oReader :: OptReader a+ } -- | Option for flags that act like switches between a default and an active -- value. Corresponds to 'Options.Applicative.flag'.-data FlagOpt (attr :: [OptAttr]) a- = FlagOpt- { _fLong :: Maybe String- , _fShort :: Maybe Char- , _fHelp :: Maybe String- , _fEnvVar :: Maybe String- , _fDefaultVal :: a- , _fReader :: OptReader a- , _fActive :: a- }+data FlagOpt (attr :: [OptAttr]) a = FlagOpt+ { _fLong :: Maybe String,+ _fShort :: Maybe Char,+ _fHelp :: Maybe String,+ _fEnvVar :: Maybe String,+ _fDefaultVal :: a,+ _fReader :: OptReader a,+ _fActive :: a+ } -- | Option for arguments (no long/short specifiers). Corresponds to -- 'Options.Applicative.argument'.-data ArgumentOpt (attr :: [OptAttr]) a- = ArgumentOpt- { _aHelp :: Maybe String- , _aMetavar :: Maybe String- , _aEnvVar :: Maybe String- , _aDefaultVal :: Maybe a- , _aDefaultStr :: Maybe String- , _aReader :: OptReader a- }+data ArgumentOpt (attr :: [OptAttr]) a = ArgumentOpt+ { _aHelp :: Maybe String,+ _aMetavar :: Maybe String,+ _aEnvVar :: Maybe String,+ _aDefaultVal :: Maybe a,+ _aDefaultStr :: Maybe String,+ _aReader :: OptReader a+ } -- | Existential wrapper for 'Opt', so that many options can be carried in -- a list.@@ -93,33 +101,32 @@ SomeOpt :: Opt a -> SomeOpt -- | Environment variable pairs, can be retrieved with 'getEnvironment'.-type Environment- = [(String, String)]+type Environment =+ [(String, String)] -- | Command line arguments, can be retrieved with 'getArgs'.-type Args- = [String]+type Args =+ [String] -- | Context to carry around, that contains environment variables and -- command line arguments.-data HargCtx- = HargCtx- { _hcEnv :: Environment- , _hcArgs :: Args- }+data HargCtx = HargCtx+ { _hcEnv :: Environment,+ _hcArgs :: Args+ } getCtx :: IO HargCtx-getCtx- = HargCtx <$> getEnvironment <*> getArgs+getCtx =+ HargCtx <$> getEnvironment <*> getArgs ctxFromArgs :: Args -> IO HargCtx-ctxFromArgs args- = HargCtx <$> getEnvironment <*> pure args+ctxFromArgs args =+ HargCtx <$> getEnvironment <*> pure args ctxFromEnv :: Environment -> IO HargCtx-ctxFromEnv env- = HargCtx <$> pure env <*> getArgs+ctxFromEnv env =+ HargCtx env <$> getArgs pureCtx :: Environment -> Args -> HargCtx-pureCtx- = HargCtx+pureCtx =+ HargCtx
src/Options/Harg/Util.hs view
@@ -1,111 +1,110 @@ {-# LANGUAGE RankNTypes #-}+ module Options.Harg.Util- ( toDummyOpts- , allToDummyOpts- , compose- , readFileBS- , readFileLBS- ) where+ ( toDummyOpts,+ allToDummyOpts,+ compose,+ readFileBS,+ readFileLBS,+ )+where -import qualified Control.Exception as Exc-import qualified Data.ByteString as BS+import qualified Control.Exception as Exc+import qualified Data.Barbie as B+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Functor.Compose (Compose (..))-import Data.Functor.Const (Const(..))-import System.Directory (doesFileExist)-import System.Exit (exitFailure)--import qualified Data.Barbie as B--import Options.Harg.Het.HList (AssocListF, MapAssocList(..))-import Options.Harg.Types-+import Data.Functor.Compose (Compose (..))+import Data.Functor.Const (Const (..))+import Options.Harg.Het.HList (AssocListF, MapAssocList (..))+import Options.Harg.Types+import System.Directory (doesFileExist)+import System.Exit (exitFailure) -compose- :: forall f g a.- ( Functor f- , B.FunctorB a- )- => (forall x. x -> g x)- -> a f- -> a (Compose f g)-compose to- = B.bmap (Compose . fmap to)+compose ::+ forall f g a.+ ( Functor f,+ B.FunctorB a+ ) =>+ (forall x. x -> g x) ->+ a f ->+ a (Compose f g)+compose to =+ B.bmap (Compose . fmap to) -- | Convert an option parser into a dummy parser. A dummy option parser always -- succeeds because options always have a default value (a monoid is used -- here). This is useful because we want to run the parser together with the -- configuration parser once in order to gather JSON file paths etc., which -- means that we still need @--help@ to work.-toDummyOpts- :: forall m a.- ( B.FunctorB a- , Monoid m- )- => a Opt- -> a (Compose Opt (Const m))-toDummyOpts- = B.bmap toDummy+toDummyOpts ::+ forall m a.+ ( B.FunctorB a,+ Monoid m+ ) =>+ a Opt ->+ a (Compose Opt (Const m))+toDummyOpts =+ B.bmap toDummy where- toDummy opt- = Compose- $ Const- <$> opt- { _optDefaultVal- = Just mempty- , _optReader- = pure . const mempty- , _optType- = case _optType opt of- OptionOptType -> OptionOptType- FlagOptType _ -> FlagOptType mempty- ArgumentOptType -> ArgumentOptType+ toDummy opt =+ Compose $+ Const+ <$> opt+ { _optDefaultVal =+ Just mempty,+ _optReader =+ pure . const mempty,+ _optType =+ case _optType opt of+ OptionOptType -> OptionOptType+ FlagOptType _ -> FlagOptType mempty+ ArgumentOptType -> ArgumentOptType } -- | Convert an association list of options in to dummy ones.-allToDummyOpts- :: forall m ts xs.- ( Monoid m- , MapAssocList xs- )- => AssocListF ts xs Opt- -> AssocListF ts xs (Compose Opt (Const m))-allToDummyOpts- = mapAssocList toDummyOpts+allToDummyOpts ::+ forall m ts xs.+ ( Monoid m,+ MapAssocList xs+ ) =>+ AssocListF ts xs Opt ->+ AssocListF ts xs (Compose Opt (Const m))+allToDummyOpts =+ mapAssocList toDummyOpts -printErrAndExit- :: forall a.- String- -> IO a-printErrAndExit- = (>> exitFailure) . putStrLn+printErrAndExit ::+ forall a.+ String ->+ IO a+printErrAndExit =+ (>> exitFailure) . putStrLn -readFileWith- :: (FilePath -> IO a)- -> FilePath- -> IO a+readFileWith ::+ (FilePath -> IO a) ->+ FilePath ->+ IO a readFileWith f path = do exists <- doesFileExist path if exists then readFile_ else printErrAndExit ("File not found: " <> path) where- readFile_- = f path- `Exc.catch` (printErrAndExit . showExc)+ readFile_ =+ f path+ `Exc.catch` (printErrAndExit . showExc) showExc :: Exc.IOException -> String- showExc exc- = "Could not read file " <> path <> ": " <> Exc.displayException exc+ showExc exc =+ "Could not read file " <> path <> ": " <> Exc.displayException exc -readFileLBS- :: FilePath- -> IO LBS.ByteString-readFileLBS- = readFileWith LBS.readFile+readFileLBS ::+ FilePath ->+ IO LBS.ByteString+readFileLBS =+ readFileWith LBS.readFile -readFileBS- :: FilePath- -> IO BS.ByteString-readFileBS- = readFileWith BS.readFile+readFileBS ::+ FilePath ->+ IO BS.ByteString+readFileBS =+ readFileWith BS.readFile
+ test/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Test suite not yet implemented"
− test/Spec.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"