configuration-tools 0.2.7 → 0.2.8

raw patch · 6 files changed

+280/−71 lines, 6 filesdep ~optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• configuration-tools.cabal +3/−3
• constraints +24/−22
• src/Configuration/Utils.hs +90/−34
• src/Configuration/Utils/Http.hs +0/−12
• src/Configuration/Utils/Validation.hs +149/−0

@@ -1,3 +1,17 @@+0.2.8+=====++*   Added validation funcitons for Boolean values, numberic values and+    orders.++*   Added operator `!..:` for parsing of configuration values that are+    required to be present in a configuration file, thus preventing+    the default value from being used.++*   More consistent usage of case in metavar values.++*   Drop support for optparse-applicative < 0.10.+ 0.2.7 ===== 

@@ -3,7 +3,7 @@ -- ------------------------------------------------------ --  Name:                configuration-tools-Version:             0.2.7+Version:             0.2.8 Synopsis:            Tools for specifying and parsing configurations description:     Tools for specifying and parsing configurations@@ -54,7 +54,7 @@ source-repository this     type: git     location: https://github.com/alephcloud/hs-configuration-tools.git-    tag: 0.2.7+    tag: 0.2.8  Library     hs-source-dirs: src@@ -83,7 +83,7 @@         errors >= 1.4.3,         mtl >= 2.2,         network-uri >= 2.6.0.1,-        optparse-applicative >= 0.8.1,+        optparse-applicative >= 0.10,         process >= 1.2.0.0,         text >= 1.0,         transformers >= 0.3.0.0,

@@ -1,37 +1,39 @@-constraints: Cabal ==1.20.0.2,+constraints: Cabal ==1.22.0.0,              MonadRandom ==0.3,-             aeson ==0.8.0.0,-             ansi-terminal ==0.6.1.1,+             aeson ==0.8.0.2,+             ansi-terminal ==0.6.2.1,              ansi-wl-pprint ==0.6.7.1,              array ==0.5.0.0,-             attoparsec ==0.12.1.0,+             async ==2.0.1.6,+             attoparsec ==0.12.1.2,              base ==4.7.0.1,              base-unicode-symbols ==0.2.2.4,              bifunctors ==4.1.1.1,+             binary ==0.7.1.0,              bytestring ==0.10.4.0,-             case-insensitive ==1.2.0.0,+             case-insensitive ==1.2.0.3,              comonad ==4.2.2,-             conduit ==1.2.0.2,-             configuration-tools ==0.2.7,+             conduit ==1.2.3.1,              containers ==0.5.5.1,-             contravariant ==1.2,+             contravariant ==1.2.0.1,              deepseq ==1.3.0.2,              directory ==1.2.1.0,              distributive ==0.4.4,              dlist ==0.7.1,-             either ==4.3.1,+             either ==4.3.2.1,+             enclosed-exceptions ==1.0.1,              errors ==1.4.7,              exceptions ==0.6.1,              filepath ==1.3.0.2,-             free ==4.9,+             free ==4.10.0.1,              ghc-prim ==0.3.1.0,-             hashable ==1.2.2.0,+             hashable ==1.2.3.1,              integer-gmp ==0.5.1.0,-             lifted-base ==0.2.3.0,+             lifted-base ==0.2.3.3,              mmorph ==1.0.4,-             monad-control ==0.3.3.0,+             monad-control ==1.0.0.1,              mtl ==2.2.1,-             nats ==0.2,+             nats ==1,              network-uri ==2.6.0.1,              old-locale ==1.0.0.6,              optparse-applicative ==0.11.0.1,@@ -40,25 +42,25 @@              pretty ==1.1.1.1,              primitive ==0.5.3.0,              process ==1.2.0.0,-             profunctors ==4.2.0.1,+             profunctors ==4.3.2,              random ==1.0.1.1,-             resourcet ==1.1.2.3,+             resourcet ==1.1.3.3,              rts ==1.0,              safe ==0.3.6,-             scientific ==0.3.3.0,+             scientific ==0.3.3.5,              semigroupoids ==4.2,-             semigroups ==0.15.3,+             semigroups ==0.16.0.1,              stm ==2.4.3,              syb ==0.4.2,              tagged ==0.7.2,              template-haskell ==2.9.0.0,-             text ==1.1.1.3,+             text ==1.2.0.3,              time ==1.4.2,              transformers ==0.4.1.0,              transformers-base ==0.4.3,              transformers-compat ==0.3.3.4,              unix ==2.7.0.1,-             unordered-containers ==0.2.5.0,+             unordered-containers ==0.2.5.1,              vector ==0.10.11.0,-             void ==0.6.1,-             yaml ==0.8.9.1+             void ==0.7,+             yaml ==0.8.10.1

@@ -9,7 +9,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}  {-# OPTIONS_HADDOCK show-extensions #-} @@ -75,6 +74,7 @@ , runWithConfiguration , PkgInfo , runWithPkgInfoConfiguration+, parseConfiguration  -- * Applicative Option Parsing with Default Values , MParser@@ -89,6 +89,7 @@ -- * Parsing of Configuration Files with Default Values , setProperty , (..:)+, (!..:) , (%.:) , module Data.Aeson @@ -136,11 +137,7 @@ import qualified Data.Text.IO as T import qualified Data.Yaml as Yaml -#if MIN_VERSION_optparse_applicative(0,10,0) import Options.Applicative hiding (Parser, Success)-#else-import Options.Applicative hiding (Parser, Success, (&))-#endif  import qualified Options.Applicative as O @@ -155,9 +152,9 @@ -- -------------------------------------------------------------------------- -- -- Useful Operators --- | This operator is an alternative for '$' with a higher precedence which--- makes it suitable for usage within Applicative style funtors without the need--- to add parenthesis.+-- | This operator is an alternative for '$' with a higher precedence. It is+-- suitable for usage within applicative style code without the need to add+-- parenthesis. -- (%) ∷ (α → β) → α → β (%) = ($)@@ -165,8 +162,8 @@ {-# INLINE (%) #-}  -- | This operator is a UTF-8 version of '%' which is an alternative for '$'--- with a higher precedence which makes it suitable for usage within Applicative--- style funtors without the need to add parenthesis.+-- with a higher precedence. It is suitable for usage within applicative style+-- code without the need to add parenthesis. -- -- The hex value of the UTF-8 character × is 0x00d7. --@@ -420,6 +417,19 @@ infix 6 %.: {-# INLINE (%.:) #-} +-- | This operator requires that a value is explicitly provided in a+-- configuration file, thus preventing the default value from being used.+-- Otherwise this operator does the same as '(..:)'.+--+(!..:)+    ∷ FromJSON β+    ⇒ Lens' α β+    → T.Text+    → Object+    → Parser (α → α)+(!..:) l property o = set l <$> (o .: property)+{-# INLINE (!..:) #-}+ -- -------------------------------------------------------------------------- -- -- Command Line Option Parsing @@ -433,21 +443,24 @@     _ → Left $ "failed to read Boolean value " <> fromString (show x)         <> ". Expected either \"true\" or \"false\"" +-- | The 'boolOption' is an alternative to 'O.switch'.+--+-- Using 'O.switch' with command line parsers that overwrite settings+-- from a configuration file is problematic: the absence of the 'switch'+-- is interpreted as setting the respective configuration value to 'False'.+-- So there is no way to specify on the command line that the value from+-- the configuration file shall be used. Some command line UIs use two+-- different options for those values, for instance @--enable-feature@ and+-- @--disable-feature@. This option instead expects a Boolean value. Beside+-- that it behaves like any other option.+-- boolOption     ∷ O.Mod O.OptionFields Bool     → O.Parser Bool-#if MIN_VERSION_optparse_applicative(0,10,0) boolOption mods = O.option (O.eitherReader boolReader)-    % O.metavar "TRUE|FALSE"+    % O.metavar "true|false"     <> O.completeWith ["true", "false", "TRUE", "FALSE", "True", "False"]     <> mods-#else-boolOption mods = O.nullOption-    % metavar "TRUE|FALSE"-    <> O.completeWith ["true", "false", "TRUE", "FALSE", "True", "False"]-    <> O.eitherReader boolReader-    <> mods-#endif  fileOption     ∷ O.Mod O.OptionFields String@@ -477,7 +490,7 @@ type ConfigValidation α λ = (MonadIO μ, Functor μ, Applicative μ, MonadError T.Text μ, MonadWriter (λ T.Text) μ) ⇒ α → μ ()  -- | A newtype wrapper around a validation function. The only purpose of--- this type is to avoid ImpredicativeTypes when storing the function+-- this type is to avoid @ImpredicativeTypes@ when storing the function -- in the 'ProgramInfoValidate' record. -- newtype ConfigValidationFunction α λ = ConfigValidationFunction@@ -494,7 +507,7 @@     , _piHelpFooter ∷ !(Maybe String)       -- ^ Help footer     , _piOptionParser ∷ !(MParser α)-      -- ^ options parser for configuration (TODO consider using a typeclass for this)+      -- ^ options parser for configuration     , _piDefaultConfiguration ∷ !α       -- ^ default configuration     , _piValidateConfiguration ∷ !(ConfigValidationFunction α λ)@@ -520,13 +533,13 @@ piHelpFooter = lens _piHelpFooter $ \s a → s { _piHelpFooter = a } {-# INLINE piHelpFooter #-} --- | options parser for configuration (TODO consider using a typeclass for this)+-- | Options parser for configuration -- piOptionParser ∷ Lens' (ProgramInfoValidate α λ) (MParser α) piOptionParser = lens _piOptionParser $ \s a → s { _piOptionParser = a } {-# INLINE piOptionParser #-} --- | default configuration+-- | Default configuration -- piDefaultConfiguration ∷ Lens' (ProgramInfoValidate α λ) α piDefaultConfiguration = lens _piDefaultConfiguration $ \s a → s { _piDefaultConfiguration = a }@@ -569,8 +582,11 @@ -- programInfo     ∷ String+        -- ^ program description     → MParser α+        -- ^ parser for updating the default configuration     → α+        -- ^ default configuration     → ProgramInfo α programInfo desc parser defaultConfig =     programInfoValidate desc parser defaultConfig $ const (return ())@@ -618,22 +634,12 @@         ⊕ O.short 'p'         ⊕ O.help "Print the parsed configuration to standard out and exit"         ⊕ O.showDefault-#if MIN_VERSION_optparse_applicative(0,10,0)     <*> O.option (O.eitherReader $ \file → fileReader file <*> pure d)         × O.long "config-file"         ⊕ O.short 'c'         ⊕ O.metavar "FILE"         ⊕ O.help "Configuration file in YAML format"         ⊕ O.value d-#else-    <*> O.nullOption-        × O.long "config-file"-        ⊕ O.short 'c'-        ⊕ O.metavar "FILE"-        ⊕ O.help "Configuration file in YAML format"-        ⊕ O.eitherReader (\file → fileReader file <*> pure d)-        ⊕ O.value d-#endif   where     fileReader file = fmapL (\e → "failed to parse configuration file " ⊕ file ⊕ ": " ⊕ show e)         $ unsafePerformIO (Yaml.decodeFileEither file)@@ -681,7 +687,11 @@ runWithConfiguration     ∷ (FromJSON (α → α), ToJSON α, Foldable λ, Monoid (λ T.Text))     ⇒ ProgramInfoValidate α λ+        -- ^ program info value; use 'programInfo' to construct a value of this+        -- type     → (α → IO ())+        -- ^ computation that is given the configuration that is parsed from+        -- the command line.     → IO () runWithConfiguration appInfo mainFunction = do     conf ← O.customExecParser parserPrefs mainOpts@@ -693,6 +703,43 @@     mainOpts = mainOptions appInfo Nothing     parserPrefs = O.prefs O.disambiguate +-- | Parse the command line arguments.+--+-- Any warnings from the configuration function are discarded.+-- The options @--print-config@ and @--help@ are just ignored.+--+-- NOTE this that this function may call 'unsafePerformIO' for+-- reading configuration files.+--+parseConfiguration+    ∷+        ( Applicative m+        , MonadIO m+        , MonadError T.Text m+        , FromJSON (α → α)+        , ToJSON α+        , Foldable λ+        , Monoid (λ T.Text)+        )+    ⇒ T.Text+        -- ^ program name (used in error messages)+    → ProgramInfoValidate α λ+        -- ^ program info value; use 'programInfo' to construct a value of this+        -- type+    → [String]+        -- ^ command line arguments+    → m α+parseConfiguration appName appInfo args = do+    case O.execParserPure parserPrefs mainOpts args of+        O.Success a → validate (_mainConfig a) >> return (_mainConfig a)+        O.Failure e → throwError ∘ T.pack ∘ fst $ renderFailure e (T.unpack appName)+        O.CompletionInvoked _ → throwError "command line parser returned completion result"+  where+    mainOpts = mainOptions appInfo Nothing+    parserPrefs = O.prefs O.disambiguate+    validate conf = runWriterT $ do+        runConfigValidation (view piValidateConfiguration appInfo) conf+ -- | Validates a configuration value. Throws an user error -- if there is an error. If there are warnings they are -- printed to 'stderr'.@@ -703,7 +750,7 @@     → α     → IO () validateConfig appInfo conf = do-    warnings ← execWriterT . exceptT (error . T.unpack) return $ do+    warnings ← execWriterT ∘ exceptT (error ∘ T.unpack) return $ do         runConfigValidation (view piValidateConfiguration appInfo) conf     when (any (const True) warnings) $ do         T.hPutStrLn stderr "WARNINGS:"@@ -793,8 +840,17 @@ runWithPkgInfoConfiguration     ∷ (FromJSON (α → α), ToJSON α, Foldable λ, Monoid (λ T.Text))     ⇒ ProgramInfoValidate α λ+        -- ^ program info value; use 'programInfo' to construct a value of this+        -- type     → PkgInfo+        -- 'PkgInfo' value that contain information about the package.+        --+        -- See the documentation of "Configuration.Utils.Setup" for a way+        -- how to generate this information automatically from the package+        -- description during the build process.     → (α → IO ())+        -- ^ computation that is given the configuration that is parsed from+        -- the command line.     → IO () runWithPkgInfoConfiguration appInfo pkgInfo mainFunction = do     conf ← O.customExecParser parserPrefs mainOpts

@@ -200,18 +200,10 @@     <$< hscHost ∘ bs .:: strOption         × long (prefix ⊕ "host")         ⊕ help "Hostname of the service"-#if MIN_VERSION_optparse_applicative(0,10,0)     <*< hscPort .:: option auto-#else-    <*< hscPort .:: option-#endif         × long (prefix ⊕ "port")         ⊕ help "Port of the service"-#if MIN_VERSION_optparse_applicative(0,10,0)     <*< hscInterface ∘ bs .:: option auto-#else-    <*< hscInterface ∘ bs .:: option-#endif         × long (prefix ⊕ "interface")         ⊕ help "Interface of the service"     <*< (hscUseTLS %:: (fmap <$> pHttpServiceTLSConfiguration prefix))@@ -271,11 +263,7 @@     <$< hccHost ∘ bs .:: strOption         × long (serviceName ⊕ "-host")         ⊕ help ("Hostname of " ⊕ serviceName)-#if MIN_VERSION_optparse_applicative(0,10,0)     <*< hccPort .:: option auto-#else-    <*< hccPort .:: option-#endif         × long (serviceName ⊕ "-port")         ⊕ help ("Port of " ⊕ serviceName)     <*< hccUseTLS .:: switch

@@ -41,6 +41,25 @@ , validateFileWritable , validateExecutable , validateDirectory++-- * Boolean Values+, validateFalse+, validateTrue+, validateBool++-- * Numeric Values+, validateNonNegative+, validatePositive+, validateNonPositive+, validateNegative+, validateNonNull++-- * Orders+, validateLess+, validateLessEq+, validateGreater+, validateGreaterEq+, validateRange ) where  import Configuration.Utils@@ -299,4 +318,134 @@                 ⊕ " you may check your SearchPath and PATH variable settings"             Just f → return f     validateFileExecutable configName execFile++-- -------------------------------------------------------------------------- --+-- Boolean Values++validateFalse+    ∷ (MonadError T.Text m)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → Bool+    → m ()+validateFalse configName = validateBool configName False++validateTrue+    ∷ (MonadError T.Text m)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → Bool+    → m ()+validateTrue configName = validateBool configName True++validateBool+    ∷ (MonadError T.Text m)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → Bool+        -- ^ expected value+    → Bool+    → m ()+validateBool configName expected x = unless (x ≡ expected) ∘ throwError $+    "expected " ⊕ configName ⊕ " to be " ⊕ sshow expected ⊕ ", but was " ⊕ sshow x++-- -------------------------------------------------------------------------- --+-- Numeric Values++validateNonNegative+    ∷ (Ord α, Num α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → ConfigValidation α λ+validateNonNegative configName x =+    when (x < 0) ∘ throwError $+        "value for " ⊕ configName ⊕ " must not be negative"++validatePositive+    ∷ (Ord α, Num α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → ConfigValidation α λ+validatePositive configName x =+    when (x ≤ 0) ∘ throwError $+        "value for " ⊕ configName ⊕ " must be positive"++validateNonPositive+    ∷ (Ord α, Num α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → ConfigValidation α λ+validateNonPositive configName x =+    when (x > 0) ∘ throwError $+        "value for " ⊕ configName ⊕ " must not be positive"++validateNegative+    ∷ (Ord α, Num α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → ConfigValidation α λ+validateNegative configName x =+    when (x ≥ 0) ∘ throwError $+        "value for " ⊕ configName ⊕ " must be negative"++validateNonNull+    ∷ (Eq α, Num α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → ConfigValidation α λ+validateNonNull configName x = when (x ≡ 0) ∘ throwError $+    "value for " ⊕ configName ⊕ " must not be zero"++-- -------------------------------------------------------------------------- --+-- Orders++validateLess+    ∷ (Ord α, Show α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → α+        -- ^ a strict upper bound for the configuration value+    → ConfigValidation α λ+validateLess configName upper x = unless (x < upper) ∘ throwError $+    "value for " ⊕ configName ⊕ " must be strictly less than " ⊕ sshow upper ⊕ ", but was " ⊕ sshow x++validateLessEq+    ∷ (Ord α, Show α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → α+        -- ^ a upper bound for the configuration value+    → ConfigValidation α λ+validateLessEq configName upper x = unless (x ≤ upper) ∘ throwError $+    "value for " ⊕ configName ⊕ " must be less or equal than " ⊕ sshow upper ⊕ ", but was " ⊕ sshow x++validateGreater+    ∷ (Ord α, Show α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → α+        -- ^ a strict lower bound for the configuration value+    → ConfigValidation α λ+validateGreater configName lower x = unless (x > lower) ∘ throwError $+    "value for " ⊕ configName ⊕ " must be strictly greater than " ⊕ sshow lower ⊕ ", but was " ⊕ sshow x++validateGreaterEq+    ∷ (Ord α, Show α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → α+        -- ^ a lower bound for the configuration value+    → ConfigValidation α λ+validateGreaterEq configName lower x = unless (x ≥ lower) ∘ throwError $+    "value for " ⊕ configName ⊕ " must be greater or equal than " ⊕ sshow lower ⊕ ", but was " ⊕ sshow x++validateRange+    ∷ (Ord α, Show α)+    ⇒ T.Text+        -- ^ configuration property name that is used in the error message+    → (α, α)+        -- ^ the valid range for the configuration value+    → ConfigValidation α λ+validateRange configName (lower,upper) x = unless (x ≥ lower ∧ x ≤ upper) ∘ throwError $+    "value for " ⊕ configName ⊕ " must be within the range of (" ⊕ sshow lower ⊕ ", " ⊕ sshow upper ⊕ "), but was " ⊕ sshow x