configuration-tools 0.3.0 → 0.3.1

raw patch · 15 files changed

+278/−227 lines, 15 filesdep +semigroupssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−1
• Setup.hs +23/−3
• configuration-tools.cabal +6/−5
• examples/Example.hs +5/−5
• src/Configuration/Utils.hs +57/−57
• src/Configuration/Utils/CommandLine.hs +8/−8
• src/Configuration/Utils/ConfigFile.hs +28/−25
• src/Configuration/Utils/Http.hs +2/−2
• src/Configuration/Utils/Internal.hs +23/−23
• src/Configuration/Utils/Internal/ConfigFileReader.hs +20/−20
• src/Configuration/Utils/Monoid.hs +15/−14
• src/Configuration/Utils/Operators.hs +8/−8
• src/Configuration/Utils/Setup.hs +23/−3
• src/Configuration/Utils/Validation.hs +36/−36
• test/TestTools.hs +17/−17

@@ -1,8 +1,14 @@+0.3.1 (2018-03-16)+==================++*   Support GHC-8.4.1 and Cabal-2.2+*   Replaced the use of non-ascii identifiers in the public API+ 0.3.0 =====  *   Remove built in short options `-p`, `-c`, and `-i`-*   Support CHG-8.2 and Cabal-2.0+*   Support GHC-8.2 and Cabal-2.0  0.2.15 ======

@@ -129,6 +129,10 @@ import Distribution.Types.UnqualComponentName #endif +#if MIN_VERSION_Cabal(2,2,0)+import Distribution.Pretty+#endif+ import System.Process  import Control.Applicative@@ -209,6 +213,8 @@     tr '-' = '_'     tr c = c +-- FIXME: autoModulesDir is deprecated and should be replaced by+-- autogenComponentModulesDir. pkgInfoFileName :: Maybe String -> LocalBuildInfo -> FilePath pkgInfoFileName cn bInfo = autogenModulesDir bInfo ++ "/" ++ pkgInfoModuleName cn ++ ".hs" @@ -235,6 +241,16 @@ unFlagName (FlagName s) = s #endif +#if !MIN_VERSION_Cabal(2,2,0)+unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]+unFlagAssignment = id+#endif++#if !MIN_VERSION_Cabal(2,2,0)+prettyShow :: Text a => a -> String+prettyShow = display+#endif+ pkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString pkgInfoModule cName pkgDesc bInfo = do     (tag, revision, branch) <- getVCS >>= \x -> case x of@@ -244,7 +260,7 @@      let vcsBranch = if branch == "default" || branch == "master" then "" else branch         vcsVersion = intercalate "-" . filter (/= "") $ [tag, revision, vcsBranch]-        flags = map (unFlagName . fst) . filter snd . configConfigurationsFlags . configFlags $ bInfo+        flags = map (unFlagName . fst) . filter snd . unFlagAssignment . configConfigurationsFlags . configFlags $ bInfo      licenseString <- licenseFilesText pkgDesc @@ -288,7 +304,7 @@             , "    arch = \"" <> (pack . display . hostPlatform) bInfo <> "\""             , ""             , "    license :: IsString a => a"-            , "    license = \"" <> (pack . display . license) pkgDesc <> "\""+            , "    license = \"" <> (pack . prettyShow . license) pkgDesc <> "\""             , ""             , "    licenseText :: IsString a => a"             , "    licenseText = " <> (pack . show) licenseString@@ -450,7 +466,11 @@ pkgIdWithLicense :: I.InstalledPackageInfo -> String pkgIdWithLicense a = (display . packageId) a     ++ " ["-    ++ (display . I.license) a+#if MIN_VERSION_Cabal(2,2,0)+    ++ (either prettyShow prettyShow . I.license) a+#else+    ++ (prettyShow . I.license) a+#endif     ++ (if cr /= "" then ", " ++ cr else "")     ++ "]"   where

@@ -1,10 +1,10 @@ -- ------------------------------------------------------ ----- Copyright © 2015-2017 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright © 2014-2015 AlephCloud Systems, Inc. -- ------------------------------------------------------ --  Name: configuration-tools-Version: 0.3.0+Version: 0.3.1 Synopsis: Tools for specifying and parsing configurations description:     Tools for specifying and parsing configurations@@ -35,7 +35,7 @@ Author: Lars Kuhtz <lakuhtz@gmail.com> Maintainer: Lars Kuhtz <lakuhtz@gmail.com> Copyright:-    (c) 2015-2017 Lars Kuhtz <lakuhtz@gmail.com>,+    (c) 2015-2018 Lars Kuhtz <lakuhtz@gmail.com>,     (c) 2014-2015 AlephCloud, Inc. Category: Configuration, Console Build-type: Custom@@ -58,7 +58,7 @@ source-repository this     type: git     location: https://github.com/alephcloud/hs-configuration-tools.git-    tag: 0.3.0+    tag: 0.3.1  flag remote-configs     Description: enable loading of configuration files from HTTP URLs@@ -109,7 +109,8 @@         text >= 1.0,         unordered-containers >= 0.2.4.0,         yaml >= 0.8.8.3,-        profunctors >= 4.0.4+        profunctors >= 4.0.4,+        semigroups >= 0.18      if flag(old-transformers)         build-depends:

@@ -58,10 +58,10 @@ -- (alternatively we could have used TemplateHaskell along with -- 'makeLenses' from "Control.Lens" from the lens package.) -user ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+user ∷ Functor f ⇒ (String → f String) → Auth → f Auth user f s = (\u → s { _user = u }) <$> f (_user s) -pwd ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+pwd ∷ Functor f ⇒ (String → f String) → Auth → f Auth pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s)  defaultAuth ∷ Auth@@ -102,13 +102,13 @@     , _path ∷ !String     } -auth ∷ Functor φ ⇒ (Auth → φ Auth) → HttpURL → φ HttpURL+auth ∷ Functor f ⇒ (Auth → f Auth) → HttpURL → f HttpURL auth f s = (\u → s { _auth = u }) <$> f (_auth s) -domain ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+domain ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL domain f s = (\u → s { _domain = u }) <$> f (_domain s) -path ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+path ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL path f s = (\u → s { _path = u }) <$> f (_path s)  defaultHttpURL ∷ HttpURL

@@ -166,24 +166,24 @@ -- this type is to avoid @ImpredicativeTypes@ when storing the function -- in the 'ProgramInfoValidate' record. ---newtype ConfigValidationFunction α λ = ConfigValidationFunction-    { runConfigValidation ∷ ConfigValidation α λ+newtype ConfigValidationFunction a f = ConfigValidationFunction+    { runConfigValidation ∷ ConfigValidation a f     } -type ProgramInfo α = ProgramInfoValidate α []+type ProgramInfo a = ProgramInfoValidate a [] -data ProgramInfoValidate α λ = ProgramInfo+data ProgramInfoValidate a f = ProgramInfo     { _piDescription ∷ !String       -- ^ Program Description     , _piHelpHeader ∷ !(Maybe String)       -- ^ Help header     , _piHelpFooter ∷ !(Maybe String)       -- ^ Help footer-    , _piOptionParser ∷ !(MParser α)+    , _piOptionParser ∷ !(MParser a)       -- ^ options parser for configuration-    , _piDefaultConfiguration ∷ !α+    , _piDefaultConfiguration ∷ !a       -- ^ default configuration-    , _piValidateConfiguration ∷ !(ConfigValidationFunction α λ)+    , _piValidateConfiguration ∷ !(ConfigValidationFunction a f)       -- ^ a validation function. The 'Right' result is interpreted as a 'Foldable'       -- structure of warnings.     , _piConfigurationFiles ∷ ![ConfigFile]@@ -193,31 +193,31 @@  -- | Program Description ---piDescription ∷ Lens' (ProgramInfoValidate α λ) String+piDescription ∷ Lens' (ProgramInfoValidate a f) String piDescription = lens _piDescription $ \s a → s { _piDescription = a } {-# INLINE piDescription #-}  -- | Help header ---piHelpHeader ∷ Lens' (ProgramInfoValidate α λ) (Maybe String)+piHelpHeader ∷ Lens' (ProgramInfoValidate a f) (Maybe String) piHelpHeader = lens _piHelpHeader $ \s a → s { _piHelpHeader = a } {-# INLINE piHelpHeader #-}  -- | Help footer ---piHelpFooter ∷ Lens' (ProgramInfoValidate α λ) (Maybe String)+piHelpFooter ∷ Lens' (ProgramInfoValidate a f) (Maybe String) piHelpFooter = lens _piHelpFooter $ \s a → s { _piHelpFooter = a } {-# INLINE piHelpFooter #-}  -- | Options parser for configuration ---piOptionParser ∷ Lens' (ProgramInfoValidate α λ) (MParser α)+piOptionParser ∷ Lens' (ProgramInfoValidate a f) (MParser a) piOptionParser = lens _piOptionParser $ \s a → s { _piOptionParser = a } {-# INLINE piOptionParser #-}  -- | Default configuration ---piDefaultConfiguration ∷ Lens' (ProgramInfoValidate α λ) α+piDefaultConfiguration ∷ Lens' (ProgramInfoValidate a f) a piDefaultConfiguration = lens _piDefaultConfiguration $ \s a → s { _piDefaultConfiguration = a } {-# INLINE piDefaultConfiguration #-} @@ -225,14 +225,14 @@ -- -- The 'Right' result is interpreted as a 'Foldable' structure of warnings. ---piValidateConfiguration ∷ Lens' (ProgramInfoValidate α λ) (ConfigValidationFunction α λ)+piValidateConfiguration ∷ Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f) piValidateConfiguration = lens _piValidateConfiguration $ \s a → s { _piValidateConfiguration = a } {-# INLINE piValidateConfiguration #-}  -- | Configuration files that are loaded in order before any command line -- argument is evaluated. ---piConfigurationFiles ∷ Lens' (ProgramInfoValidate α λ) [ConfigFile]+piConfigurationFiles ∷ Lens' (ProgramInfoValidate a f) [ConfigFile] piConfigurationFiles = lens _piConfigurationFiles $ \s a → s { _piConfigurationFiles = a } {-# INLINE piConfigurationFiles #-} @@ -242,10 +242,10 @@ -- piOptionParserAndDefaultConfiguration     ∷ Lens-        (ProgramInfoValidate α λ)-        (ProgramInfoValidate β γ)-        (MParser α, α, ConfigValidationFunction α λ)-        (MParser β, β, ConfigValidationFunction β γ)+        (ProgramInfoValidate a b)+        (ProgramInfoValidate c d)+        (MParser a, a, ConfigValidationFunction a b)+        (MParser c, c, ConfigValidationFunction c d) piOptionParserAndDefaultConfiguration = lens g $ \s (a,b,c) → ProgramInfo     { _piDescription = _piDescription s     , _piHelpHeader = _piHelpHeader s@@ -267,11 +267,11 @@ programInfo     ∷ String         -- ^ program description-    → MParser α+    → MParser a         -- ^ parser for updating the default configuration-    → α+    → a         -- ^ default configuration-    → ProgramInfo α+    → ProgramInfo a programInfo desc parser defaultConfig =     programInfoValidate desc parser defaultConfig $ const (return ()) @@ -281,10 +281,10 @@ -- programInfoValidate     ∷ String-    → MParser α-    → α-    → ConfigValidation α λ-    → ProgramInfoValidate α λ+    → MParser a+    → a+    → ConfigValidation a f+    → ProgramInfoValidate a f programInfoValidate desc parser defaultConfig valFunc = ProgramInfo     { _piDescription = desc     , _piHelpHeader = Nothing@@ -310,37 +310,37 @@ -- NOTE that /meta/ configuration settings can only be provided via command -- line options but not through configuration files. ---data AppConfiguration α = AppConfiguration+data AppConfiguration a = AppConfiguration     { _printConfig ∷ !Bool     , _configFilesConfig ∷ !ConfigFilesConfig     , _configFiles ∷ ![ConfigFile]-    , _mainConfig ∷ !α+    , _mainConfig ∷ !a     }  -- | A flag that indicates that the application should output the effective -- configuration and exit. ---printConfig ∷ Lens' (AppConfiguration α) Bool+printConfig ∷ Lens' (AppConfiguration a) Bool printConfig = lens _printConfig $ \s a → s { _printConfig = a }  -- | The 'ConfigFilesConfig' collects all parameters that determine how -- configuration files are loaded and parsed. ---configFilesConfig ∷ Lens' (AppConfiguration α) ConfigFilesConfig+configFilesConfig ∷ Lens' (AppConfiguration a) ConfigFilesConfig configFilesConfig = lens _configFilesConfig $ \s a → s { _configFilesConfig = a }  -- | A list of configuration file locations. Configuration file locations are -- set either statically in the code or are provided dynamically on the command -- line via @--config-file@ options. ---configFiles ∷ Lens' (AppConfiguration α) [ConfigFile]+configFiles ∷ Lens' (AppConfiguration a) [ConfigFile] configFiles = lens _configFiles $ \s a → s { _configFiles = a }  -- | The /user/ configuration. During parsing this is represented as an update -- function that yields a configuration value when applied to a default -- value. ---mainConfig ∷ Lens (AppConfiguration α) (AppConfiguration β) α β+mainConfig ∷ Lens (AppConfiguration a) (AppConfiguration b) a b mainConfig = lens _mainConfig $ \s a → s { _mainConfig = a }  -- | This function parsers /all/ command line options:@@ -357,8 +357,8 @@ --    value when applied to an default value. -- pAppConfiguration-    ∷ O.Parser (α → α)-    → O.Parser (AppConfiguration (α → α))+    ∷ O.Parser (a → a)+    → O.Parser (AppConfiguration (a → a)) pAppConfiguration mainParser = AppConfiguration     <$> pPrintConfig     <*> (pConfigFilesConfig <*> pure defaultConfigFilesConfig)@@ -407,11 +407,11 @@ --     to the service. -- runWithConfiguration-    ∷ (FromJSON (α → α), ToJSON α, Foldable λ, Monoid (λ T.Text))-    ⇒ ProgramInfoValidate α λ+    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))+    ⇒ ProgramInfoValidate a f         -- ^ program info value; use 'programInfo' to construct a value of this         -- type-    → (α → IO ())+    → (a → IO ())         -- ^ computation that is given the configuration that is parsed from         -- the command line.     → IO ()@@ -420,7 +420,7 @@ -- -------------------------------------------------------------------------- -- -- Main Configuration with Package Info -pPkgInfo ∷ PkgInfo → MParser α+pPkgInfo ∷ PkgInfo → MParser a pPkgInfo (sinfo, detailedInfo, version, license) =     infoO <*> detailedInfoO <*> versionO <*> licenseO   where@@ -502,8 +502,8 @@ --     to the service. -- runWithPkgInfoConfiguration-    ∷ (FromJSON (α → α), ToJSON α, Foldable λ, Monoid (λ T.Text))-    ⇒ ProgramInfoValidate α λ+    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))+    ⇒ ProgramInfoValidate a f         -- ^ program info value; use 'programInfo' to construct a value of this         -- type     → PkgInfo@@ -512,7 +512,7 @@         -- 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 ())+    → (a → IO ())         -- ^ computation that is given the configuration that is parsed from         -- the command line.     → IO ()@@ -523,16 +523,16 @@ -- Internal main function  mainOptions-    ∷ ∀ α λ . FromJSON (α → α)-    ⇒ ProgramInfoValidate α λ+    ∷ ∀ a f . FromJSON (a → a)+    ⇒ ProgramInfoValidate a f         -- ^ Program Info value which may include a validation function -    → (∀ β . Maybe (MParser β))+    → (∀ b . Maybe (MParser b))         -- ^ Maybe a package info parser. This parser is run only for its         -- side effects. It is supposed to /intercept/ the parsing process         -- and execute any implied action (showing help messages). -    → O.ParserInfo (AppConfiguration (α → α))+    → O.ParserInfo (AppConfiguration (a → a)) mainOptions ProgramInfo{..} pkgInfoParser = O.info optionParser     $ O.progDesc _piDescription     ⊕ O.fullDesc@@ -593,17 +593,17 @@ -- | Internal main function -- runInternal-    ∷ (FromJSON (α → α), ToJSON α, Foldable λ, Monoid (λ T.Text))-    ⇒ ProgramInfoValidate α λ+    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))+    ⇒ ProgramInfoValidate a f         -- ^ program info value; use 'programInfo' to construct a value of this         -- type-    → (∀ β . Maybe (MParser β))+    → (∀ b . Maybe (MParser b))         -- 'PkgInfo' value that contains 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 ())+    → (a → IO ())         -- ^ computation that is given the configuration that is parsed from         -- the command line.     → IO ()@@ -641,19 +641,19 @@         , MonadBaseControl IO m #endif         , MonadError T.Text m-        , FromJSON (α → α)-        , ToJSON α-        , Foldable λ-        , Monoid (λ T.Text)+        , FromJSON (a → a)+        , ToJSON a+        , Foldable f+        , Monoid (f T.Text)         )     ⇒ T.Text         -- ^ program name (used in error messages)-    → ProgramInfoValidate α λ+    → ProgramInfoValidate a f         -- ^ program info value; use 'programInfo' to construct a value of this         -- type     → [String]         -- ^ command line arguments-    → m α+    → m a parseConfiguration appName appInfo args = do      -- Parse command line arguments (add static config files to resulting app config)@@ -685,9 +685,9 @@ -- printed to 'stderr'. -- validateConfig-    ∷ (Foldable λ, Monoid (λ T.Text))-    ⇒ ProgramInfoValidate α λ-    → α+    ∷ (Foldable f, Monoid (f T.Text))+    ⇒ ProgramInfoValidate a f+    → a     → IO () validateConfig appInfo conf = do     warnings ← execWriterT ∘ exceptT (error ∘ T.unpack) return $

@@ -79,7 +79,7 @@  -- | Type of option parsers that yield a modification function. ---type MParser α = O.Parser (α → α)+type MParser a = O.Parser (a → a)  -- | An operator for applying a setter to an option parser that yields a value. --@@ -90,10 +90,10 @@ -- >     , _pwd ∷ !String -- >     } -- >--- > user ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+-- > user ∷ Functor f ⇒ (String → f String) → Auth → f Auth -- > user f s = (\u → s { _user = u }) <$> f (_user s) -- >--- > pwd ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+-- > pwd ∷ Functor f ⇒ (String → f String) → Auth → f Auth -- > pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -109,7 +109,7 @@ -- >        × long "pwd" -- >        ⊕ help "password for user" ---(.::) ∷ (Alternative φ, Applicative φ) ⇒ Lens' α β → φ β → φ (α → α)+(.::) ∷ (Alternative f, Applicative f) ⇒ Lens' a b → f b → f (a → a) (.::) a opt = set a <$> opt <|> pure id infixr 5 .:: {-# INLINE (.::) #-}@@ -124,13 +124,13 @@ -- >     , _domain ∷ !String -- >     } -- >--- > auth ∷ Functor φ ⇒ (Auth → φ Auth) → HttpURL → φ HttpURL+-- > auth ∷ Functor f ⇒ (Auth → f Auth) → HttpURL → f HttpURL -- > auth f s = (\u → s { _auth = u }) <$> f (_auth s) -- >--- > domain ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > domain ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > domain f s = (\u → s { _domain = u }) <$> f (_domain s) -- >--- > path ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > path ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > path f s = (\u → s { _path = u }) <$> f (_path s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -144,7 +144,7 @@ -- >         ⊕ short 'd' -- >         ⊕ help "HTTP domain" ---(%::) ∷ (Alternative φ, Applicative φ) ⇒ Lens' α β → φ (β → β) → φ (α → α)+(%::) ∷ (Alternative f, Applicative f) ⇒ Lens' a b → f (b → b) → f (a → a) (%::) a opt = over a <$> opt <|> pure id infixr 5 %:: {-# INLINE (%::) #-}

@@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -91,10 +90,10 @@ -- >     , _pwd ∷ !String -- >     } -- >--- > userId ∷ Functor φ ⇒ (Int → φ Int) → Auth → φ Auth+-- > userId ∷ Functor f ⇒ (Int → f Int) → Auth → f Auth -- > userId f s = (\u → s { _userId = u }) <$> f (_userId s) -- >--- > pwd ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+-- > pwd ∷ Functor f ⇒ (String → f String) → Auth → f Auth -- > pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -111,11 +110,11 @@ -- >             e → fail $ "unrecognized user " ⊕ e -- setProperty-    ∷ Lens' α β -- ^ a lens into the target that is updated by the parser+    ∷ Lens' a b -- ^ a lens into the target that is updated by the parser     → T.Text -- ^ the JSON property name-    → (Value → Parser β) -- ^ the JSON 'Value' parser that is used to parse the value of the property+    → (Value → Parser b) -- ^ the JSON 'Value' parser that is used to parse the value of the property     → Object -- ^ the parsed JSON 'Value' 'Object'-    → Parser (α → α)+    → Parser (a → a) setProperty s k p o = case H.lookup k o of     Nothing → pure id     Just v → set s <$> p v@@ -129,10 +128,10 @@ -- >     , _pwd ∷ !String -- >     } -- >--- > user ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+-- > user ∷ Functor f ⇒ (String → f String) → Auth → f Auth -- > user f s = (\u → s { _user = u }) <$> f (_user s) -- >--- > pwd ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth+-- > pwd ∷ Functor f ⇒ (String → f String) → Auth → f Auth -- > pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -143,7 +142,7 @@ -- >         <$< user ..: "user" × o -- >         <*< pwd ..: "pwd" × o ---(..:) ∷ FromJSON β ⇒ Lens' α β → T.Text → Object → Parser (α → α)+(..:) ∷ FromJSON b ⇒ Lens' a b → T.Text → Object → Parser (a → a) (..:) s k = setProperty s k parseJSON infix 6 ..: {-# INLINE (..:) #-}@@ -152,18 +151,22 @@ -- of a given 'Object' and updates a setter with the parsed -- function. --+-- This function is useful when a 'FromJSON' instance isn't available.+-- When a 'FromJSON' instance exists, the '%.:' provides a more+-- ideomatic alternative.+-- -- > data HttpURL = HttpURL -- >     { _auth ∷ !Auth -- >     , _domain ∷ !String -- >     } -- >--- > auth ∷ Functor φ ⇒ (Auth → φ Auth) → HttpURL → φ HttpURL+-- > auth ∷ Functor f ⇒ (Auth → f Auth) → HttpURL → f HttpURL -- > auth f s = (\u → s { _auth = u }) <$> f (_auth s) -- >--- > domain ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > domain ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > domain f s = (\u → s { _domain = u }) <$> f (_domain s) -- >--- > path ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > path ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > path f s = (\u → s { _path = u }) <$> f (_path s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -171,21 +174,21 @@ -- > -- > instance FromJSON (HttpURL → HttpURL) where -- >     parseJSON = withObject "HttpURL" $ \o → id--- >         <$< auth %.: "auth" × o--- >         <*< domain ..: "domain" × o+-- >         <$< updateProperty auth "auth" parseJSON o+-- >         <*< setProperty domain "domain" parseJSON o -- updateProperty-    ∷ Lens' α β+    ∷ Lens' a b     → T.Text-    → (Value → Parser (β → β))+    → (Value → Parser (b → b))     → Object-    → Parser (α → α)+    → Parser (a → a) updateProperty s k p o = case H.lookup k o of     Nothing → pure id     Just v → over s <$> p v {-# INLINE updateProperty #-} --- | A variant of 'updateProperty' that used the 'FromJSON' instance+-- | A variant of 'updateProperty' that uses the 'FromJSON' instance -- for the update function. It mimics the aeson operator '.:'. -- It creates a parser that modifies a setter with a parsed function. --@@ -194,13 +197,13 @@ -- >     , _domain ∷ !String -- >     } -- >--- > auth ∷ Functor φ ⇒ (Auth → φ Auth) → HttpURL → φ HttpURL+-- > auth ∷ Functor f ⇒ (Auth → f Auth) → HttpURL → f HttpURL -- > auth f s = (\u → s { _auth = u }) <$> f (_auth s) -- >--- > domain ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > domain ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > domain f s = (\u → s { _domain = u }) <$> f (_domain s) -- >--- > path ∷ Functor φ ⇒ (String → φ String) → HttpURL → φ HttpURL+-- > path ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL -- > path f s = (\u → s { _path = u }) <$> f (_path s) -- > -- > -- or with lenses and TemplateHaskell just:@@ -211,7 +214,7 @@ -- >         <$< auth %.: "auth" × o -- >         <*< domain ..: "domain" × o ---(%.:) ∷ FromJSON (β → β) ⇒ Lens' α β → T.Text → Object → Parser (α → α)+(%.:) ∷ FromJSON (b → b) ⇒ Lens' a b → T.Text → Object → Parser (a → a) (%.:) s k = updateProperty s k parseJSON infix 6 %.: {-# INLINE (%.:) #-}@@ -221,11 +224,11 @@ -- Otherwise this operator does the same as '(..:)'. -- (!..:)-    ∷ FromJSON β-    ⇒ Lens' α β+    ∷ FromJSON b+    ⇒ Lens' a b     → T.Text     → Object-    → Parser (α → α)+    → Parser (a → a) (!..:) l property o = set l <$> (o .: property) {-# INLINE (!..:) #-} 

@@ -86,7 +86,7 @@     }  validateHttpServiceTLSConfiguration-    ∷ ConfigValidation HttpServiceTLSConfiguration λ+    ∷ ConfigValidation HttpServiceTLSConfiguration f validateHttpServiceTLSConfiguration conf = do     validateFileReadable "cert-file" $ _hstcCertFile conf     validateFileReadable "key-file" $ _hstcKeyFile conf@@ -237,7 +237,7 @@     , _hccUseTLS = False     } -validateHttpClientConfiguration ∷ ConfigValidation HttpClientConfiguration λ+validateHttpClientConfiguration ∷ ConfigValidation HttpClientConfiguration f validateHttpClientConfiguration conf = do     validatePort "port" $ _hccPort conf     validateNonEmpty "host" $ _hccHost conf

@@ -62,28 +62,28 @@ -- In case it is already import from the lens package this should be hidden -- from the import. ---type Lens σ τ α β = ∀ φ . Functor φ ⇒ (α → φ β) → σ → φ τ+type Lens s t a b = ∀ f . Functor f ⇒ (a → f b) → s → f t  -- | This is the same type as the type from the lens library with the same name. -- -- In case it is already import from the lens package this should be hidden -- from the import. ---type Lens' σ α = Lens σ σ α α+type Lens' s a = Lens s s a a -lens ∷ (σ → α) → (σ → β → τ) → Lens σ τ α β+lens ∷ (s → a) → (s → b → t) → Lens s t a b lens getter setter lGetter s = setter s `fmap` lGetter (getter s) {-# INLINE lens #-} -over ∷ ((α → Identity β) → σ → Identity τ) → (α → β) → σ → τ+over ∷ ((a → Identity b) → s → Identity t) → (a → b) → s → t over s f = runIdentity . s (Identity . f) {-# INLINE over #-} -set ∷ ((α → Identity β) → σ → Identity τ) → β → σ → τ+set ∷ ((a → Identity b) → s → Identity t) → b → s → t set s a = runIdentity . s (const $ Identity a) {-# INLINE set #-} -view ∷ MonadReader σ μ ⇒ ((α → Const α α) → σ → Const α σ) → μ α+view ∷ MonadReader r m ⇒ ((a → Const a a) → r → Const a r) → m a view l = asks (getConst #. l Const) {-# INLINE view #-} @@ -92,48 +92,48 @@ -- In case it is already import from the lens package this should be hidden -- from the import. ---type Iso σ τ α β = ∀ π φ . (Profunctor π, Functor φ) ⇒ π α (φ β) → π σ (φ τ)-type Iso' σ α = Iso σ σ α α+type Iso s t a b = ∀ p f . (Profunctor p, Functor f) ⇒ p a (f b) → p s (f t)+type Iso' s a = Iso s s a a -iso ∷ (σ → α) → (β → τ) → Iso σ τ α β+iso ∷ (s → a) → (b → t) → Iso s t a b iso f g = dimap f (fmap g) {-# INLINE iso #-}  -- -------------------------------------------------------------------------- -- -- Misc Utils -(&) ∷ α → (α → β) → β+(&) ∷ a → (a → b) → b (&) = flip ($) {-# INLINE (&) #-} -(<&>) ∷ Functor φ ⇒ φ α → (α → β) → φ β+(<&>) ∷ Functor f ⇒ f a → (a → b) → f b (<&>) = flip fmap {-# INLINE (<&>) #-}  sshow-    ∷ (Show α, IsString τ)-    ⇒ α-    → τ+    ∷ (Show a, IsString s)+    ⇒ a+    → s sshow = fromString ∘ show {-# INLINE sshow #-}  exceptT-    ∷ Monad μ-    ⇒ (ε → μ β)-    → (α → μ β)-    → ExceptT ε μ α-    → μ β+    ∷ Monad m+    ⇒ (e → m b)+    → (a → m b)+    → ExceptT e m a+    → m b exceptT a b = runExceptT >=> either a b {-# INLINE exceptT #-}  errorT-    ∷ Monad μ-    ⇒ ExceptT T.Text μ α-    → μ α+    ∷ Monad m+    ⇒ ExceptT T.Text m a+    → m a errorT = exceptT (\e → error ∘ T.unpack $ "Error: " ⊕ e) return {-# INLINE errorT #-} -fmapL ∷ (α → β) → Either α γ → Either β γ+fmapL ∷ (a → b) → Either a c → Either b c fmapL f = either (Left ∘ f) Right {-# INLINE fmapL #-} 

@@ -79,39 +79,39 @@ -- Tools for parsing configuration files  #ifdef REMOTE_CONFIGS-type ConfigFileParser μ =-    ( Functor μ-    , Applicative μ-    , MonadIO μ-    , MonadBaseControl IO μ-    , MonadError T.Text μ+type ConfigFileParser m =+    ( Functor m+    , Applicative m+    , MonadIO m+    , MonadBaseControl IO m+    , MonadError T.Text m     ) #else-type ConfigFileParser μ =-    ( Functor μ-    , Applicative μ-    , MonadIO μ-    , MonadError T.Text μ+type ConfigFileParser m =+    ( Functor m+    , Applicative m+    , MonadIO m+    , MonadError T.Text m     ) #endif  parseConfigFiles-    ∷ (ConfigFileParser μ, FromJSON (α → α))+    ∷ (ConfigFileParser m, FromJSON (a → a))     ⇒ ConfigFilesConfig-    → α+    → a         -- ^ default configuration value     → [ConfigFile]         -- ^ list of configuration file paths-    → μ α+    → m a parseConfigFiles conf = foldM $ \val file →     readConfigFile conf file <*> pure val  readConfigFile-    ∷ (ConfigFileParser μ, FromJSON (α → α))+    ∷ (ConfigFileParser m, FromJSON (a → a))     ⇒ ConfigFilesConfig     → ConfigFile         -- ^ file path-    → μ (α → α)+    → m (a → a) readConfigFile _conf file = #ifdef REMOTE_CONFIGS     if isRemote file then loadRemote _conf file else loadLocal file@@ -128,10 +128,10 @@     | otherwise = Other  loadLocal-    ∷ (Functor μ, MonadIO μ, MonadError T.Text μ, FromJSON (α → α))+    ∷ (Functor m, MonadIO m, MonadError T.Text m, FromJSON (a → a))     ⇒ ConfigFile         -- ^ file path-    → μ (α → α)+    → m (a → a) loadLocal path = do     validateFilePath "config-file" (T.unpack file)     exists ← (True <$ validateFile "config-file" (T.unpack file)) `catchError` \e → case path of@@ -182,11 +182,11 @@     | otherwise = Other  loadRemote-    ∷ (ConfigFileParser μ, FromJSON (α → α))+    ∷ (ConfigFileParser m, FromJSON (a → a))     ⇒ ConfigFilesConfig     → ConfigFile         -- ^ URL-    → μ (α → α)+    → m (a → a) loadRemote conf path = do     validateHttpOrHttpsUrl "config-file" (T.unpack url)     result ← (Just <$> doHttp) `catchAnyDeep` \e →

@@ -35,6 +35,7 @@ import Control.Monad.Writer hiding (mapM_)  import Data.Aeson+import Data.Semigroup  import qualified Options.Applicative.Types as O @@ -45,10 +46,10 @@ -- circumstances you'll never use this type directly but only -- its 'FromJSON' instance. See the 'leftMonoidalUpdate' for an example. ---newtype LeftMonoidalUpdate α = LeftMonoidalUpdate-    { _getLeftMonoidalUpdate ∷ α+newtype LeftMonoidalUpdate a = LeftMonoidalUpdate+    { _getLeftMonoidalUpdate ∷ a     }-    deriving (Monoid)+    deriving (Semigroup, Monoid)  -- | Update a value by appending on the left. --@@ -60,16 +61,16 @@ -- >     parseJSON = withObject "RoutingTable" $ \o → id -- >         <$< routingTableMap . from leftMonoidalUpdate %.: "route_map" % o ---leftMonoidalUpdate ∷ Iso (LeftMonoidalUpdate α) (LeftMonoidalUpdate β) α β+leftMonoidalUpdate ∷ Iso (LeftMonoidalUpdate a) (LeftMonoidalUpdate b) a b leftMonoidalUpdate = iso _getLeftMonoidalUpdate LeftMonoidalUpdate  -- | This is the same as @from leftMonoidalUpdate@ but doesn't depend on -- the lens Library. ---fromLeftMonoidalUpdate ∷ Iso α β (LeftMonoidalUpdate α) (LeftMonoidalUpdate β)+fromLeftMonoidalUpdate ∷ Iso a b (LeftMonoidalUpdate a) (LeftMonoidalUpdate b) fromLeftMonoidalUpdate = iso LeftMonoidalUpdate _getLeftMonoidalUpdate -instance (FromJSON α, Monoid α) ⇒ FromJSON (LeftMonoidalUpdate α → LeftMonoidalUpdate α) where+instance (FromJSON a, Monoid a) ⇒ FromJSON (LeftMonoidalUpdate a → LeftMonoidalUpdate a) where     parseJSON = fmap (mappend ∘ LeftMonoidalUpdate) ∘ parseJSON  -- | Update a value by appending on the left.@@ -95,36 +96,36 @@ -- > -- >     fmapL f = either (Left . f) Right ---pLeftMonoidalUpdate ∷ Monoid α ⇒ O.Parser α → MParser α+pLeftMonoidalUpdate ∷ Monoid a ⇒ O.Parser a → MParser a pLeftMonoidalUpdate pElement = mappend ∘ mconcat ∘ reverse <$> many pElement  -- | Update a value by appending on the right. Under normal -- circumstances you'll never use this type directly but only -- its 'FromJSON' instance. See the 'leftMonoidalUpdate' for an example. ---newtype RightMonoidalUpdate α = RightMonoidalUpdate-    { _getRightMonoidalUpdate ∷ α+newtype RightMonoidalUpdate a = RightMonoidalUpdate+    { _getRightMonoidalUpdate ∷ a     }-    deriving (Monoid)+    deriving (Semigroup, Monoid)  -- | Update a value by appending on the right. See 'leftMonoidalUpdate' for -- an usage example. ---rightMonoidalUpdate ∷ Iso (RightMonoidalUpdate α) (RightMonoidalUpdate β) α β+rightMonoidalUpdate ∷ Iso (RightMonoidalUpdate a) (RightMonoidalUpdate b) a b rightMonoidalUpdate = iso _getRightMonoidalUpdate RightMonoidalUpdate  -- | This is the same as @from rightMonoidalUpdate@ but doesn't depend on -- the lens Library. ---fromRightMonoidalUpdate ∷ Iso α β (RightMonoidalUpdate α) (RightMonoidalUpdate β)+fromRightMonoidalUpdate ∷ Iso a b (RightMonoidalUpdate a) (RightMonoidalUpdate b) fromRightMonoidalUpdate = iso RightMonoidalUpdate _getRightMonoidalUpdate -instance (FromJSON α, Monoid α) ⇒ FromJSON (RightMonoidalUpdate α → RightMonoidalUpdate α) where+instance (FromJSON a, Monoid a) ⇒ FromJSON (RightMonoidalUpdate a → RightMonoidalUpdate a) where     parseJSON = fmap (flip mappend ∘ RightMonoidalUpdate) ∘ parseJSON  -- | Update a value by appending on the right. See 'pLeftMonoidalUpdate' -- for an usage example. ---pRightMonoidalUpdate ∷ Monoid α ⇒ O.Parser α → MParser α+pRightMonoidalUpdate ∷ Monoid a ⇒ O.Parser a → MParser a pRightMonoidalUpdate pElement = flip mappend ∘ mconcat <$> many pElement 

@@ -40,7 +40,7 @@ -- suitable for usage within applicative style code without the need to add -- parenthesis. ---(%) ∷ (α → β) → α → β+(%) ∷ (a → b) → a → b (%) = ($) infixr 5 % {-# INLINE (%) #-}@@ -58,14 +58,14 @@ -- -- > iabbrev <buffer> >< × ---(×) ∷ (α → β) → α → β+(×) ∷ (a → b) → a → b (×) = ($) infixr 5 × {-# INLINE (×) #-}  -- | Functional composition for applicative functors. ---(<*<) ∷ Applicative φ ⇒ φ (β → γ) → φ (α → β) → φ (α → γ)+(<*<) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c) (<*<) a b = pure (.) <*> a <*> b infixr 4 <*< {-# INLINE (<*<) #-}@@ -73,7 +73,7 @@ -- | Functional composition for applicative functors with its arguments -- flipped. ---(>*>) ∷ Applicative φ ⇒ φ (α → β) → φ (β → γ) → φ (α → γ)+(>*>) ∷ Applicative f ⇒ f (a → b) → f (b → c) → f (a → c) (>*>) = flip (<*<) infixr 4 >*> {-# INLINE (>*>) #-}@@ -81,7 +81,7 @@ -- | Applicative functional composition between a pure function -- and an applicative function. ---(<$<) ∷ Functor φ ⇒ (β → γ) → φ (α → β) → φ (α → γ)+(<$<) ∷ Functor f ⇒ (b → c) → f (a → b) → f (a → c) (<$<) a b = (a .) <$> b infixr 4 <$< {-# INLINE (<$<) #-}@@ -89,7 +89,7 @@ -- | Applicative functional composition between a pure function -- and an applicative function with its arguments flipped. ---(>$>) ∷ Functor φ ⇒ φ (α → β) → (β → γ) → φ (α → γ)+(>$>) ∷ Functor f ⇒ f (a → b) → (b → c) → f (a → c) (>$>) = flip (<$<) infixr 4 >$> {-# INLINE (>$>) #-}@@ -99,7 +99,7 @@ -- This is a rather popular operator. Due to conflicts (for instance with the -- lens package) it may have to be imported qualified. ---(<.>) ∷ Applicative φ ⇒ φ (β → γ) → φ (α → β) → φ (α → γ)+(<.>) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c) (<.>) = (<*<) infixr 4 <.> {-# INLINE (<.>) #-}@@ -114,7 +114,7 @@ -- -- > iabbrev <buffer> ../ ⊙ ---(⊙) ∷ Applicative φ ⇒ φ (β → γ) → φ (α → β) → φ (α → γ)+(⊙) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c) (⊙) = (<.>) infixr 4 ⊙ {-# INLINE (⊙) #-}

@@ -129,6 +129,10 @@ import Distribution.Types.UnqualComponentName #endif +#if MIN_VERSION_Cabal(2,2,0)+import Distribution.Pretty+#endif+ import System.Process  import Control.Applicative@@ -209,6 +213,8 @@     tr '-' = '_'     tr c = c +-- FIXME: autoModulesDir is deprecated and should be replaced by+-- autogenComponentModulesDir. pkgInfoFileName :: Maybe String -> LocalBuildInfo -> FilePath pkgInfoFileName cn bInfo = autogenModulesDir bInfo ++ "/" ++ pkgInfoModuleName cn ++ ".hs" @@ -235,6 +241,16 @@ unFlagName (FlagName s) = s #endif +#if !MIN_VERSION_Cabal(2,2,0)+unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]+unFlagAssignment = id+#endif++#if !MIN_VERSION_Cabal(2,2,0)+prettyShow :: Text a => a -> String+prettyShow = display+#endif+ pkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString pkgInfoModule cName pkgDesc bInfo = do     (tag, revision, branch) <- getVCS >>= \x -> case x of@@ -244,7 +260,7 @@      let vcsBranch = if branch == "default" || branch == "master" then "" else branch         vcsVersion = intercalate "-" . filter (/= "") $ [tag, revision, vcsBranch]-        flags = map (unFlagName . fst) . filter snd . configConfigurationsFlags . configFlags $ bInfo+        flags = map (unFlagName . fst) . filter snd . unFlagAssignment . configConfigurationsFlags . configFlags $ bInfo      licenseString <- licenseFilesText pkgDesc @@ -288,7 +304,7 @@             , "    arch = \"" <> (pack . display . hostPlatform) bInfo <> "\""             , ""             , "    license :: IsString a => a"-            , "    license = \"" <> (pack . display . license) pkgDesc <> "\""+            , "    license = \"" <> (pack . prettyShow . license) pkgDesc <> "\""             , ""             , "    licenseText :: IsString a => a"             , "    licenseText = " <> (pack . show) licenseString@@ -450,7 +466,11 @@ pkgIdWithLicense :: I.InstalledPackageInfo -> String pkgIdWithLicense a = (display . packageId) a     ++ " ["-    ++ (display . I.license) a+#if MIN_VERSION_Cabal(2,2,0)+    ++ (either prettyShow prettyShow . I.license) a+#else+    ++ (prettyShow . I.license) a+#endif     ++ (if cr /= "" then ", " ++ cr else "")     ++ "]"   where

@@ -95,7 +95,7 @@ -- | A validation function. The type in the 'MonadWriter' is excpected to -- be a 'Foldable' structure for collecting warnings. ---type ConfigValidation α λ = ∀ μ . (MonadIO μ, Functor μ, Applicative μ, MonadError T.Text μ, MonadWriter (λ T.Text) μ) ⇒ α → μ ()+type ConfigValidation a f = ∀ m . (MonadIO m, Functor m, Applicative m, MonadError T.Text m, MonadWriter (f T.Text) m) ⇒ a → m ()  -- -------------------------------------------------------------------------- -- -- Networking@@ -216,60 +216,60 @@ -- Monoids, Foldables, and Co  validateNonEmpty-    ∷ (MonadError T.Text m, Eq α, Monoid α)+    ∷ (MonadError T.Text m, Eq a, Monoid a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validateNonEmpty configName x =     when (x ≡ mempty) ∘ throwError $         "value for " ⊕ configName ⊕ " must not be empty"  validateLength-    ∷ (MonadError T.Text m, F.Foldable φ)+    ∷ (MonadError T.Text m, F.Foldable f)     ⇒ T.Text         -- ^ configuration property name that is used in the error message     → Int         -- ^ exact length of the validated value-    → φ α+    → f a     → m () validateLength configName len x =     unless (length (F.toList x) ≡ len) ∘ throwError $         "value for " ⊕ configName ⊕ " must be of length exactly " ⊕ sshow len  validateMaxLength-    ∷ (MonadError T.Text m, F.Foldable φ)+    ∷ (MonadError T.Text m, F.Foldable f)     ⇒ T.Text         -- ^ configuration property name that is used in the error message     → Int         -- ^ maximum length of the validated value-    → φ α+    → f a     → m () validateMaxLength configName u x =     unless (length (F.toList x) ≤ u) ∘ throwError $         "value for " ⊕ configName ⊕ " must be of length at most " ⊕ sshow u  validateMinLength-    ∷ (MonadError T.Text m, F.Foldable φ)+    ∷ (MonadError T.Text m, F.Foldable f)     ⇒ T.Text         -- ^ configuration property name that is used in the error message     → Int         -- ^ minimum length of the validated value-    → φ α+    → f a     → m () validateMinLength configName l x =     unless (length (F.toList x) ≥ l) ∘ throwError $         "value for " ⊕ configName ⊕ " must be of length at least " ⊕ sshow l  validateMinMaxLength-    ∷ (MonadError T.Text m, F.Foldable φ)+    ∷ (MonadError T.Text m, F.Foldable f)     ⇒ T.Text         -- ^ configuration property name that is used in the error message     → Int         -- ^ minimum length of the validated value     → Int         -- ^ maximum length of the validated value-    → φ α+    → f a     → m () validateMinMaxLength configName l u x =     unless (len ≥ l && len ≤ u) ∘ throwError $@@ -411,50 +411,50 @@ -- Numeric Values  validateNonNegative-    ∷ (MonadError T.Text m, Ord α, Num α)+    ∷ (MonadError T.Text m, Ord a, Num a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validateNonNegative configName x =     when (x < 0) ∘ throwError $         "value for " ⊕ configName ⊕ " must not be negative"  validatePositive-    ∷ (MonadError T.Text m, Ord α, Num α)+    ∷ (MonadError T.Text m, Ord a, Num a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validatePositive configName x =     when (x ≤ 0) ∘ throwError $         "value for " ⊕ configName ⊕ " must be positive"  validateNonPositive-    ∷ (MonadError T.Text m, Ord α, Num α)+    ∷ (MonadError T.Text m, Ord a, Num a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validateNonPositive configName x =     when (x > 0) ∘ throwError $         "value for " ⊕ configName ⊕ " must not be positive"  validateNegative-    ∷ (MonadError T.Text m, Ord α, Num α)+    ∷ (MonadError T.Text m, Ord a, Num a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validateNegative configName x =     when (x ≥ 0) ∘ throwError $         "value for " ⊕ configName ⊕ " must be negative"  validateNonNull-    ∷ (MonadError T.Text m, Eq α, Num α)+    ∷ (MonadError T.Text m, Eq a, Num a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a     → m () validateNonNull configName x = when (x ≡ 0) ∘ throwError $     "value for " ⊕ configName ⊕ " must not be zero"@@ -463,56 +463,56 @@ -- Orders  validateLess-    ∷ (MonadError T.Text m, Ord α, Show α)+    ∷ (MonadError T.Text m, Ord a, Show a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a         -- ^ a strict upper bound for the configuration value-    → α+    → a     → m () validateLess configName upper x = unless (x < upper) ∘ throwError $     "value for " ⊕ configName ⊕ " must be strictly less than " ⊕ sshow upper ⊕ ", but was " ⊕ sshow x  validateLessEq-    ∷ (MonadError T.Text m, Ord α, Show α)+    ∷ (MonadError T.Text m, Ord a, Show a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a         -- ^ a upper bound for the configuration value-    → α+    → a     → m () validateLessEq configName upper x = unless (x ≤ upper) ∘ throwError $     "value for " ⊕ configName ⊕ " must be less or equal than " ⊕ sshow upper ⊕ ", but was " ⊕ sshow x  validateGreater-    ∷ (MonadError T.Text m, Ord α, Show α)+    ∷ (MonadError T.Text m, Ord a, Show a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a         -- ^ a strict lower bound for the configuration value-    → α+    → a     → m () validateGreater configName lower x = unless (x > lower) ∘ throwError $     "value for " ⊕ configName ⊕ " must be strictly greater than " ⊕ sshow lower ⊕ ", but was " ⊕ sshow x  validateGreaterEq-    ∷ (MonadError T.Text m, Ord α, Show α)+    ∷ (MonadError T.Text m, Ord a, Show a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → α+    → a         -- ^ a lower bound for the configuration value-    → α+    → a     → m () validateGreaterEq configName lower x = unless (x ≥ lower) ∘ throwError $     "value for " ⊕ configName ⊕ " must be greater or equal than " ⊕ sshow lower ⊕ ", but was " ⊕ sshow x  validateRange-    ∷ (MonadError T.Text m, Ord α, Show α)+    ∷ (MonadError T.Text m, Ord a, Show a)     ⇒ T.Text         -- ^ configuration property name that is used in the error message-    → (α, α)+    → (a, a)         -- ^ the valid range for the configuration value-    → α+    → a     → m () 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

@@ -102,12 +102,12 @@ -- 2. lens for the configuration value -- 3. the expected value ---data ConfAssertion β = ∀ α . Eq α ⇒ ConfAssertion [String] (Lens' β α) α+data ConfAssertion b = ∀ a . Eq a ⇒ ConfAssertion [String] (Lens' b a) a -trueLens ∷ Lens' β ()+trueLens ∷ Lens' b () trueLens = lens (const ()) const -trueAssertion ∷ [String] → ConfAssertion β+trueAssertion ∷ [String] → ConfAssertion b trueAssertion args = ConfAssertion args trueLens ()  -- -------------------------------------------------------------------------- --@@ -116,8 +116,8 @@ -- Check the given list of assertions for the given configuration value -- check-    ∷ α-    → [ConfAssertion α]+    ∷ a+    → [ConfAssertion a]     → IO Bool check conf assertions =     foldM (\a (b,n) → (&& a) <$> go b n) True $ zip assertions [0 ∷ Int ..]@@ -135,14 +135,14 @@ -- for a given that of assertions. -- runTest-    ∷ (FromJSON (α → α), ToJSON α)+    ∷ (FromJSON (a → a), ToJSON a)     ⇒ PkgInfo-    → ProgramInfoValidate α []+    → ProgramInfoValidate a []     → T.Text         -- ^ label for the test case     → Bool         -- ^ expected outcome-    → [ConfAssertion α]+    → [ConfAssertion a]         -- ^ test assertions     → IO Bool runTest pkgInfo mInfo label succeed assertions = do@@ -179,11 +179,11 @@ --  withConfigFile-    ∷ ToJSON γ+    ∷ ToJSON b     ⇒ ConfigFileFormat-    → γ-    → (T.Text → IO α)-    → IO α+    → b+    → (T.Text → IO a)+    → IO a withConfigFile format config inner =     withTempFile "." ("tmp_TestExample." ⊕ suffix format) $ \tmpPath tmpHandle → do         B8.hPutStrLn tmpHandle ∘ formatter format $ config@@ -197,8 +197,8 @@  withConfigFileText     ∷ T.Text-    → (T.Text → IO α)-    → IO α+    → (T.Text → IO a)+    → IO a withConfigFileText configText inner =     withTempFile "." "tmp_TestExample.txt" $ \tmpPath tmpHandle → do         T.hPutStrLn tmpHandle configText@@ -207,7 +207,7 @@   #ifdef REMOTE_CONFIGS-data ConfigType = ∀ γ . ToJSON γ ⇒ ConfigType γ+data ConfigType = ∀ a . ToJSON a ⇒ ConfigType a  instance ToJSON ConfigType where     toJSON (ConfigType a) = toJSON a@@ -216,8 +216,8 @@     ∷ [(T.Text, ConfigType)]     → [(T.Text, T.Text)]     → Maybe ConfigFileFormat-    → IO α-    → IO α+    → IO a+    → IO a withConfigFileServer configs configTexts maybeFormat inner = do     w0 ← forkIO $ WARP.run serverPort app     w1 ←  forkIO $ WARP.runTLS tlsSettings (warpSettings serverTlsPort) app