packages feed

configuration-tools 0.7.0 → 0.7.1

raw patch · 10 files changed

+165/−88 lines, 10 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Configuration.Utils: data ProgramInfoValidate a f
- Configuration.Utils: type ConfigValidation a f = forall m. (MonadIO m, Functor m, Applicative m, MonadError Text m, MonadWriter (f Text) m) => a -> m ()
+ Configuration.Utils: instance GHC.Base.Functor Configuration.Utils.AppConfiguration
+ Configuration.Utils: type ConfigValidation a f = ConfigValidation' a f ()
+ Configuration.Utils: type ProgramInfoValidate a f = ProgramInfoValidate' a f a
+ Configuration.Utils.Internal: type Setter s t a b = (a -> Identity b) -> s -> Identity t
+ Configuration.Utils.Internal: type Setter' s a = Setter s s a a
+ Configuration.Utils.Validation: type ConfigValidation a f = ConfigValidation' a f ()
- Configuration.Utils: ConfigValidationFunction :: ConfigValidation a f -> ConfigValidationFunction a f
+ Configuration.Utils: ConfigValidationFunction :: ConfigValidation' a f r -> ConfigValidationFunction a f r
- Configuration.Utils: [runConfigValidation] :: ConfigValidationFunction a f -> ConfigValidation a f
+ Configuration.Utils: [runConfigValidation] :: ConfigValidationFunction a f r -> ConfigValidation' a f r
- Configuration.Utils: newtype ConfigValidationFunction a f
+ Configuration.Utils: newtype ConfigValidationFunction a f r
- Configuration.Utils: parseConfiguration :: (Applicative m, MonadIO m, MonadError Text m, FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) => Text -> ProgramInfoValidate a f -> [String] -> m a
+ Configuration.Utils: parseConfiguration :: (Applicative m, MonadIO m, MonadError Text m, FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) => Text -> ProgramInfoValidate' a f r -> [String] -> m a
- Configuration.Utils: piDefaultConfiguration :: Lens' (ProgramInfoValidate a f) a
+ Configuration.Utils: piDefaultConfiguration :: Lens' (ProgramInfoValidate' a f r) a
- Configuration.Utils: piDescription :: Lens' (ProgramInfoValidate a f) String
+ Configuration.Utils: piDescription :: Lens' (ProgramInfoValidate' a f r) String
- Configuration.Utils: piHelpFooter :: Lens' (ProgramInfoValidate a f) (Maybe String)
+ Configuration.Utils: piHelpFooter :: Lens' (ProgramInfoValidate' a f r) (Maybe String)
- Configuration.Utils: piHelpHeader :: Lens' (ProgramInfoValidate a f) (Maybe String)
+ Configuration.Utils: piHelpHeader :: Lens' (ProgramInfoValidate' a f r) (Maybe String)
- Configuration.Utils: piOptionParser :: Lens' (ProgramInfoValidate a f) (MParser a)
+ Configuration.Utils: piOptionParser :: Lens' (ProgramInfoValidate' a f r) (MParser a)
- Configuration.Utils: piOptionParserAndDefaultConfiguration :: Lens (ProgramInfoValidate a b) (ProgramInfoValidate c d) (MParser a, a, ConfigValidationFunction a b) (MParser c, c, ConfigValidationFunction c d)
+ Configuration.Utils: piOptionParserAndDefaultConfiguration :: Lens (ProgramInfoValidate' a b r) (ProgramInfoValidate' c d r') (MParser a, a, ConfigValidationFunction a b r) (MParser c, c, ConfigValidationFunction c d r')
- Configuration.Utils: piValidateConfiguration :: Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
+ Configuration.Utils: piValidateConfiguration :: Lens' (ProgramInfoValidate' a f r) (ConfigValidationFunction a f r)
- Configuration.Utils: runWithConfiguration :: (FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) => ProgramInfoValidate a f -> (a -> IO ()) -> IO ()
+ Configuration.Utils: runWithConfiguration :: (FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) => ProgramInfoValidate' a f r -> (r -> IO ()) -> IO ()
- Configuration.Utils.CommandLine: class HasCompleter (f :: Type -> Type)
+ Configuration.Utils.CommandLine: class () => HasCompleter (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasMetavar (f :: Type -> Type)
+ Configuration.Utils.CommandLine: class () => HasMetavar (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasName (f :: Type -> Type)
+ Configuration.Utils.CommandLine: class () => HasName (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasValue (f :: Type -> Type)
+ Configuration.Utils.CommandLine: class () => HasValue (f :: Type -> Type)
- Configuration.Utils.CommandLine: data ArgumentFields a
+ Configuration.Utils.CommandLine: data () => ArgumentFields a
- Configuration.Utils.CommandLine: data CommandFields a
+ Configuration.Utils.CommandLine: data () => CommandFields a
- Configuration.Utils.CommandLine: data Completer
+ Configuration.Utils.CommandLine: data () => Completer
- Configuration.Utils.CommandLine: data FlagFields a
+ Configuration.Utils.CommandLine: data () => FlagFields a
- Configuration.Utils.CommandLine: data InfoMod a
+ Configuration.Utils.CommandLine: data () => InfoMod a
- Configuration.Utils.CommandLine: data Mod (f :: Type -> Type) a
+ Configuration.Utils.CommandLine: data () => Mod (f :: Type -> Type) a
- Configuration.Utils.CommandLine: data OptionFields a
+ Configuration.Utils.CommandLine: data () => OptionFields a
- Configuration.Utils.CommandLine: data ParseError
+ Configuration.Utils.CommandLine: data () => ParseError
- Configuration.Utils.CommandLine: data ParserHelp
+ Configuration.Utils.CommandLine: data () => ParserHelp
- Configuration.Utils.CommandLine: data ParserInfo a
+ Configuration.Utils.CommandLine: data () => ParserInfo a
- Configuration.Utils.CommandLine: data ParserPrefs
+ Configuration.Utils.CommandLine: data () => ParserPrefs
- Configuration.Utils.CommandLine: data ParserResult a
+ Configuration.Utils.CommandLine: data () => ParserResult a
- Configuration.Utils.CommandLine: data PrefsMod
+ Configuration.Utils.CommandLine: data () => PrefsMod
- Configuration.Utils.CommandLine: data ReadM a
+ Configuration.Utils.CommandLine: data () => ReadM a
- Configuration.Utils.CommandLine: newtype CompletionResult
+ Configuration.Utils.CommandLine: newtype () => CompletionResult
- Configuration.Utils.CommandLine: newtype Const a (b :: k)
+ Configuration.Utils.CommandLine: newtype () => Const a (b :: k)
- Configuration.Utils.CommandLine: newtype ParserFailure h
+ Configuration.Utils.CommandLine: newtype () => ParserFailure h
- Configuration.Utils.CommandLine: newtype WrappedArrow (a :: Type -> Type -> Type) b c
+ Configuration.Utils.CommandLine: newtype () => WrappedArrow (a :: Type -> Type -> Type) b c
- Configuration.Utils.CommandLine: newtype WrappedMonad (m :: Type -> Type) a
+ Configuration.Utils.CommandLine: newtype () => WrappedMonad (m :: Type -> Type) a
- Configuration.Utils.CommandLine: newtype ZipList a
+ Configuration.Utils.CommandLine: newtype () => ZipList a
- Configuration.Utils.ConfigFile: (%.:) :: FromJSON (b -> b) => Lens' a b -> Text -> Object -> Parser (a -> a)
+ Configuration.Utils.ConfigFile: (%.:) :: FromJSON (b -> b) => Setter' a b -> Text -> Object -> Parser (a -> a)
- Configuration.Utils.ConfigFile: (..:) :: FromJSON b => Lens' a b -> Text -> Object -> Parser (a -> a)
+ Configuration.Utils.ConfigFile: (..:) :: FromJSON b => Setter' a b -> Text -> Object -> Parser (a -> a)
- Configuration.Utils.ConfigFile: setProperty :: Lens' a b -> Text -> (Value -> Parser b) -> Object -> Parser (a -> a)
+ Configuration.Utils.ConfigFile: setProperty :: Setter' a b -> Text -> (Value -> Parser b) -> Object -> Parser (a -> a)
- Configuration.Utils.ConfigFile: updateProperty :: Lens' a b -> Text -> (Value -> Parser (b -> b)) -> Object -> Parser (a -> a)
+ Configuration.Utils.ConfigFile: updateProperty :: Setter' a b -> Text -> (Value -> Parser (b -> b)) -> Object -> Parser (a -> a)
- Configuration.Utils.Internal: over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
+ Configuration.Utils.Internal: over :: Setter s t a b -> (a -> b) -> s -> t
- Configuration.Utils.Internal: set :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
+ Configuration.Utils.Internal: set :: Setter s t a b -> b -> s -> t
- Configuration.Utils.Validation: type ConfigValidation a f = forall m. (MonadIO m, Functor m, Applicative m, MonadError Text m, MonadWriter (f Text) m) => a -> m ()
+ Configuration.Utils.Validation: type ConfigValidation' a f r = forall m. (MonadIO m, Functor m, Applicative m, MonadError Text m, MonadWriter (f Text) m) => a -> m r

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # configuration-tools +## 0.7.1 (2025-03-04)++* Support lastest GHC (9.12)+* Use setters instead of lenses in ..: and %.:+* Allow validation functions to return new values+ ## 0.7.0 (2022-06-22)  The version bump is due to the update of the dependency on optparse-applicative,
Setup.hs view
@@ -110,6 +110,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex import Distribution.Simple.Setup+import Distribution.Simple.Utils (createDirectoryIfMissingVerbose) import Distribution.Text import Distribution.Utils.Path import Distribution.Utils.ShortText@@ -128,10 +129,17 @@ import Prelude hiding (readFile, writeFile)  import System.Directory-    (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist,-    doesFileExist, getCurrentDirectory)+    ( canonicalizePath+    , doesDirectoryExist+    , doesFileExist+    , getCurrentDirectory+    ) import System.Exit (ExitCode(ExitSuccess))+#if MIN_VERSION_Cabal(3,14,0)+import System.FilePath (isDrive, takeDirectory)+#else import System.FilePath (isDrive, takeDirectory, (</>))+#endif  -- | Include this function when your setup doesn't contain any -- extra functionality.@@ -162,6 +170,11 @@ prettyLicense :: I.InstalledPackageInfo -> String prettyLicense = either prettyShow prettyShow . I.license +#if !MIN_VERSION_Cabal(3,14,0)+interpretSymbolicPath :: Maybe () -> FilePath -> FilePath+interpretSymbolicPath _ p = p+#endif+ -- -------------------------------------------------------------------------- -- -- Cabal 2.0 @@ -173,28 +186,31 @@     -> LocalBuildInfo     -> IO () mkPkgInfoModulesPostConf hook args flags pkgDesc bInfo = do-    mapM_ (updatePkgInfoModule pkgDesc bInfo) $ Graph.toList $ componentGraph bInfo+    mapM_ (updatePkgInfoModule pkgDesc bInfo flags) $ Graph.toList $ componentGraph bInfo     hook args flags pkgDesc bInfo -updatePkgInfoModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()-updatePkgInfoModule pkgDesc bInfo clbInfo = do-    createDirectoryIfMissing True dirName+updatePkgInfoModule+    :: PackageDescription+    -> LocalBuildInfo+    -> ConfigFlags+    -> ComponentLocalBuildInfo+    -> IO ()+updatePkgInfoModule pkgDesc bInfo flags clbInfo = do+    createDirectoryIfMissingVerbose verbosity True dirName     moduleBytes <- pkgInfoModule moduleName cName pkgDesc bInfo     updateFile fileName moduleBytes      -- legacy module     legacyModuleBytes <- pkgInfoModule legacyModuleName cName pkgDesc bInfo     updateFile legacyFileName legacyModuleBytes-   where-    dirName = autogenComponentModulesDir bInfo clbInfo+    verbosity = fromFlag $ configVerbosity flags+    dirName = interpretSymbolicPath Nothing $ autogenComponentModulesDir bInfo clbInfo     cName = unUnqualComponentName <$> componentNameString (componentLocalName clbInfo)-     moduleName = pkgInfoModuleName-    fileName = dirName ++ "/" ++ moduleName ++ ".hs"-+    fileName = dirName </> moduleName <> ".hs"     legacyModuleName = legacyPkgInfoModuleName cName-    legacyFileName = dirName ++ "/" ++ legacyModuleName ++ ".hs"+    legacyFileName = dirName </> legacyModuleName <> ".hs"  -- -------------------------------------------------------------------------- -- -- Generate PkgInfo Module@@ -214,7 +230,7 @@  legacyPkgInfoModuleName :: Maybe String -> String legacyPkgInfoModuleName Nothing = "PkgInfo"-legacyPkgInfoModuleName (Just cn) = "PkgInfo_" ++ map tr cn+legacyPkgInfoModuleName (Just cn) = "PkgInfo_" <> map tr cn   where     tr '-' = '_'     tr c = c@@ -236,7 +252,12 @@                 then return Nothing                 else getVcsOfDir (takeDirectory canonicDir) -pkgInfoModule :: String -> Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString+pkgInfoModule+    :: String+    -> Maybe String+    -> PackageDescription+    -> LocalBuildInfo+    -> IO B.ByteString pkgInfoModule moduleName cName pkgDesc bInfo = do     (tag, revision, branch) <- getVCS >>= \case         Just Mercurial -> hgInfo
configuration-tools.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: configuration-tools-version: 0.7.0+version: 0.7.1 synopsis: Tools for specifying and parsing configurations description:     Tools for specifying and parsing configurations@@ -30,19 +30,20 @@ license: MIT license-file: LICENSE author: Lars Kuhtz <lakuhtz@gmail.com>-maintainer: Lars Kuhtz <lakuhtz@gmail.com>+maintainer: Lars Kuhtz <lakuhtz@gmail.com>, Edmund Noble <edmundnoble@gmail.com> copyright:+    (c) 2024-2025 Edmund Noble <edmundnoble@gmail.com>,     (c) 2019-2020 Colin Woodbury <colin@fosskers.ca>,-    (c) 2015-2023 Lars Kuhtz <lakuhtz@gmail.com>,+    (c) 2015-2025 Lars Kuhtz <lakuhtz@gmail.com>,     (c) 2014-2015 AlephCloud, Inc. category: Configuration, Console build-type: Custom tested-with:+    , GHC==9.12+    , GHC==9.10+    , GHC==9.8     , GHC==9.6     , GHC==9.4-    , GHC==9.2-    , GHC==9.0.1-    , GHC==8.10.7  extra-doc-files:     README.md,
src/Configuration/Utils.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -135,7 +136,7 @@  import Control.Monad (void, when) import Control.Monad.Except (MonadError, throwError)-import Control.Monad.Writer (execWriterT, runWriterT)+import Control.Monad.Writer (runWriterT) import Control.Monad.IO.Class (MonadIO)  import qualified Data.ByteString.Char8 as B8@@ -170,13 +171,13 @@ -- this type is to avoid @ImpredicativeTypes@ when storing the function -- in the 'ProgramInfoValidate' record. ---newtype ConfigValidationFunction a f = ConfigValidationFunction-    { runConfigValidation ∷ ConfigValidation a f+newtype ConfigValidationFunction a f r = ConfigValidationFunction+    { runConfigValidation ∷ ConfigValidation' a f r     }  type ProgramInfo a = ProgramInfoValidate a [] -data ProgramInfoValidate a f = ProgramInfo+data ProgramInfoValidate' a f r = ProgramInfo     { _piDescription ∷ !String       -- ^ Program Description     , _piHelpHeader ∷ !(Maybe String)@@ -187,7 +188,7 @@       -- ^ options parser for configuration     , _piDefaultConfiguration ∷ !a       -- ^ default configuration-    , _piValidateConfiguration ∷ !(ConfigValidationFunction a f)+    , _piValidateConfiguration ∷ !(ConfigValidationFunction a f r)       -- ^ a validation function. The 'Right' result is interpreted as a 'Foldable'       -- structure of warnings.     , _piConfigurationFiles ∷ ![ConfigFile]@@ -195,33 +196,35 @@       -- before any command line argument is evaluated.     } +type ProgramInfoValidate a f = ProgramInfoValidate' a f a+ -- | Program Description ---piDescription ∷ Lens' (ProgramInfoValidate a f) String+piDescription ∷ Lens' (ProgramInfoValidate' a f r) String piDescription = lens _piDescription $ \s a → s { _piDescription = a } {-# INLINE piDescription #-}  -- | Help header ---piHelpHeader ∷ Lens' (ProgramInfoValidate a f) (Maybe String)+piHelpHeader ∷ Lens' (ProgramInfoValidate' a f r) (Maybe String) piHelpHeader = lens _piHelpHeader $ \s a → s { _piHelpHeader = a } {-# INLINE piHelpHeader #-}  -- | Help footer ---piHelpFooter ∷ Lens' (ProgramInfoValidate a f) (Maybe String)+piHelpFooter ∷ Lens' (ProgramInfoValidate' a f r) (Maybe String) piHelpFooter = lens _piHelpFooter $ \s a → s { _piHelpFooter = a } {-# INLINE piHelpFooter #-}  -- | Options parser for configuration ---piOptionParser ∷ Lens' (ProgramInfoValidate a f) (MParser a)+piOptionParser ∷ Lens' (ProgramInfoValidate' a f r) (MParser a) piOptionParser = lens _piOptionParser $ \s a → s { _piOptionParser = a } {-# INLINE piOptionParser #-}  -- | Default configuration ---piDefaultConfiguration ∷ Lens' (ProgramInfoValidate a f) a+piDefaultConfiguration ∷ Lens' (ProgramInfoValidate' a f r) a piDefaultConfiguration = lens _piDefaultConfiguration $ \s a → s { _piDefaultConfiguration = a } {-# INLINE piDefaultConfiguration #-} @@ -229,7 +232,7 @@ -- -- The 'Right' result is interpreted as a 'Foldable' structure of warnings. ---piValidateConfiguration ∷ Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)+piValidateConfiguration ∷ Lens' (ProgramInfoValidate' a f r) (ConfigValidationFunction a f r) piValidateConfiguration = lens _piValidateConfiguration $ \s a → s { _piValidateConfiguration = a } {-# INLINE piValidateConfiguration #-} @@ -246,10 +249,10 @@ -- piOptionParserAndDefaultConfiguration     ∷ Lens-        (ProgramInfoValidate a b)-        (ProgramInfoValidate c d)-        (MParser a, a, ConfigValidationFunction a b)-        (MParser c, c, ConfigValidationFunction c d)+        (ProgramInfoValidate' a b r)+        (ProgramInfoValidate' c d r')+        (MParser a, a, ConfigValidationFunction a b r)+        (MParser c, c, ConfigValidationFunction c d r') piOptionParserAndDefaultConfiguration = lens g $ \s (a,b,c) → ProgramInfo     { _piDescription = _piDescription s     , _piHelpHeader = _piHelpHeader s@@ -283,13 +286,13 @@ -- -- 'piHelpHeader' and 'piHelpFooter' are set to 'Nothing'. ---programInfoValidate+programInfoValidate'     ∷ String     → MParser a     → a-    → ConfigValidation a f-    → ProgramInfoValidate a f-programInfoValidate desc parser defaultConfig valFunc = ProgramInfo+    → ConfigValidation' a f r+    → ProgramInfoValidate' a f r+programInfoValidate' desc parser defaultConfig valFunc = ProgramInfo     { _piDescription = desc     , _piHelpHeader = Nothing     , _piHelpFooter = Nothing@@ -299,6 +302,19 @@     , _piConfigurationFiles = []     } +-- | Smart constructor for 'ProgramInfo'.+--+-- 'piHelpHeader' and 'piHelpFooter' are set to 'Nothing'.+--+programInfoValidate+    ∷ String+    → MParser a+    → a+    → ConfigValidation a f+    → ProgramInfoValidate a f+programInfoValidate desc parser defaultConfig valFunc =+    programInfoValidate' desc parser defaultConfig $ \c -> valFunc c >> return c+ -- -------------------------------------------------------------------------- -- -- AppConfiguration @@ -343,6 +359,7 @@     , _configFiles ∷ ![ConfigFile]     , _mainConfig ∷ !a     }+    deriving Functor  -- | A list of configuration file locations. Configuration file locations are -- set either statically in the code or are provided dynamically on the command@@ -446,10 +463,10 @@ -- runWithConfiguration     ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))-    ⇒ ProgramInfoValidate a f+    ⇒ ProgramInfoValidate' a f r         -- ^ program info value; use 'programInfo' to construct a value of this         -- type-    → (a → IO ())+    → (r → IO ())         -- ^ computation that is given the configuration that is parsed from         -- the command line.     → IO ()@@ -574,8 +591,8 @@ -- Internal main function  mainOptions-    ∷ ∀ a f . FromJSON (a → a)-    ⇒ ProgramInfoValidate a f+    ∷ ∀ a f r . FromJSON (a → a)+    ⇒ ProgramInfoValidate' a f r         -- ^ Program Info value which may include a validation function      → (∀ b . Maybe (MParser b))@@ -646,7 +663,7 @@ -- runInternal     ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))-    ⇒ ProgramInfoValidate a f+    ⇒ ProgramInfoValidate' a f r         -- ^ program info value; use 'programInfo' to construct a value of this         -- type     → (∀ b . Maybe (MParser b))@@ -655,7 +672,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.-    → (a → IO ())+    → (r → IO ())         -- ^ computation that is given the configuration that is parsed from         -- the command line.     → IO ()@@ -672,10 +689,10 @@         (_configFiles cliAppConf)      -- Validate final configuration-    validateConfig appInfo $ _mainConfig appConf+    validatedConf ← validateConfig appInfo $ _mainConfig appConf      case _printConfig appConf of-        Nothing → mainFunction ∘ _mainConfig $ appConf+        Nothing → mainFunction ∘ _mainConfig $ validatedConf <$ appConf         Just Full → B8.putStrLn ∘ Yaml.encode ∘ _mainConfig $ appConf         Just Minimal → B8.putStrLn             ∘ Yaml.encode@@ -714,7 +731,7 @@         )     ⇒ T.Text         -- ^ program name (used in error messages)-    → ProgramInfoValidate a f+    → ProgramInfoValidate' a f r         -- ^ program info value; use 'programInfo' to construct a value of this         -- type     → [String]@@ -752,12 +769,13 @@ -- validateConfig     ∷ (Foldable f, Monoid (f T.Text))-    ⇒ ProgramInfoValidate a f+    ⇒ ProgramInfoValidate' a f r     → a-    → IO ()+    → IO r validateConfig appInfo conf = do-    warnings ← execWriterT ∘ exceptT (error ∘ T.unpack) return $+    (r, warnings) ← runWriterT ∘ exceptT (error ∘ T.unpack) return $         runConfigValidation (view piValidateConfiguration appInfo) conf     when (any (const True) warnings) $ do         T.hPutStrLn stderr "WARNINGS:"         mapM_ (\w → T.hPutStrLn stderr $ "warning: " ⊕ w) warnings+    return r
src/Configuration/Utils/ConfigFile.hs view
@@ -78,7 +78,6 @@ import Data.Monoid.Unicode import Data.String import qualified Data.Text as T-import Data.Typeable  import Prelude hiding (any, concatMap, mapM_) @@ -126,7 +125,7 @@ -- >             e → fail $ "unrecognized user " ⊕ e -- setProperty-    ∷ Lens' a b -- ^ a lens into the target that is updated by the parser+    ∷ Setter' a b -- ^ a lens into the target that is updated by the parser     → T.Text -- ^ the JSON property name     → (Value → Parser b) -- ^ the JSON 'Value' parser that is used to parse the value of the property     → Object -- ^ the parsed JSON 'Value' 'Object'@@ -158,7 +157,7 @@ -- >         <$< user ..: "user" % o -- >         <*< pwd ..: "pwd" % o ---(..:) ∷ FromJSON b ⇒ Lens' a b → T.Text → Object → Parser (a → a)+(..:) ∷ FromJSON b ⇒ Setter' a b → T.Text → Object → Parser (a → a) (..:) s k = setProperty s k parseJSON infix 6 ..: {-# INLINE (..:) #-}@@ -194,7 +193,7 @@ -- >         <*< setProperty domain "domain" parseJSON o -- updateProperty-    ∷ Lens' a b+    ∷ Setter' a b     → T.Text     → (Value → Parser (b → b))     → Object@@ -230,7 +229,7 @@ -- >         <$< auth %.: "auth" % o -- >         <*< domain ..: "domain" % o ---(%.:) ∷ FromJSON (b → b) ⇒ Lens' a b → T.Text → Object → Parser (a → a)+(%.:) ∷ FromJSON (b → b) ⇒ Setter' a b → T.Text → Object → Parser (a → a) (%.:) s k = updateProperty s k parseJSON infix 6 %.: {-# INLINE (%.:) #-}@@ -254,7 +253,7 @@ data ConfigFile     = ConfigFileRequired { getConfigFile ∷ !T.Text }     | ConfigFileOptional { getConfigFile ∷ !T.Text }-    deriving (Show, Read, Eq, Ord, Typeable)+    deriving (Show, Read, Eq, Ord)  -- | An /internal/ type for the meta configuration that specifies how the -- configuration files are loaded and parsed.@@ -263,7 +262,7 @@ data ConfigFilesConfig = ConfigFilesConfig     { _cfcHttpsPolicy ∷ !HttpsCertPolicy     }-    deriving (Show, Eq, Typeable)+    deriving (Show, Eq)  cfcHttpsPolicy ∷ Lens' ConfigFilesConfig HttpsCertPolicy cfcHttpsPolicy = lens _cfcHttpsPolicy $ \a b → a { _cfcHttpsPolicy = b }
src/Configuration/Utils/Internal.hs view
@@ -21,6 +21,8 @@ , view , Lens' , Lens+, Setter'+, Setter , Iso' , Iso , iso@@ -70,15 +72,29 @@ -- type Lens' s a = Lens s s a a +-- | This is almost 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 Setter s t a b = (a -> Identity b) -> s -> Identity t++-- | This is almost 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 Setter' s a = Setter s s a a+ 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 ∷ ((a → Identity b) → s → Identity t) → (a → b) → s → t+over ∷ Setter s t a b → (a → b) → s → t over s f = runIdentity . s (Identity . f) {-# INLINE over #-} -set ∷ ((a → Identity b) → s → Identity t) → b → s → t+set ∷ Setter s t a b → b → s → t set s a = runIdentity . s (const $ Identity a) {-# INLINE set #-} @@ -123,4 +139,3 @@     → m a errorT = exceptT (\e → error ∘ T.unpack $ "Error: " ⊕ e) return {-# INLINE errorT #-}-
src/Configuration/Utils/Internal/ConfigFileReader.hs view
@@ -50,7 +50,6 @@ import qualified Data.ByteString.Char8 as B8 import Data.Monoid.Unicode import qualified Data.Text as T-import Data.Typeable import qualified Data.Yaml as Yaml  import GHC.Generics@@ -155,7 +154,7 @@     = Yaml     | Json     | Other-    deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Generic)+    deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)  instance NFData ConfigFileFormat 
src/Configuration/Utils/Internal/HttpsCertPolicy.hs view
@@ -52,7 +52,6 @@ import Data.String import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Data.Typeable import qualified Data.X509 as TLS import qualified Data.X509.Validation as TLS @@ -80,7 +79,7 @@     , _certPolicyHostFingerprints ∷ !(HM.HashMap TLS.ServiceID TLS.Fingerprint)         -- ^ a whitelist for services with trusted certificates     }-    deriving (Show, Eq, Typeable)+    deriving (Show, Eq)  certPolicyInsecure ∷ Lens' HttpsCertPolicy Bool certPolicyInsecure = lens _certPolicyInsecure $ \s a → s { _certPolicyInsecure = a }@@ -177,7 +176,7 @@ -- In particular exceptions should include rejected certificates. -- newtype VerboseTlsException = VerboseTlsException T.Text-    deriving (Eq, Ord, Typeable)+    deriving (Eq, Ord)  instance Show VerboseTlsException where     show (VerboseTlsException msg) = "TLS exception: " ⊕ T.unpack msg@@ -189,7 +188,7 @@     → Maybe (TLS.SignedExact TLS.Certificate)     → TLS.TLSException     → IO a-handleTlsException request cert e@(TLS.HandshakeFailed (TLS.Error_Protocol (msg, _b, _alert)))+handleTlsException request cert e@(TLS.HandshakeFailed (TLS.Error_Protocol msg _))     | "certificate rejected: [SelfSigned]" `L.isPrefixOf` msg = throwIO ∘ VerboseTlsException         $ "The server uses a self-signed certificate. If you are sure that no-one"         ⊕ " is intercepting the connection and this is the correct certificate you"
src/Configuration/Utils/Setup.hs view
@@ -110,6 +110,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex import Distribution.Simple.Setup+import Distribution.Simple.Utils (createDirectoryIfMissingVerbose) import Distribution.Text import Distribution.Utils.Path import Distribution.Utils.ShortText@@ -128,10 +129,17 @@ import Prelude hiding (readFile, writeFile)  import System.Directory-    (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist,-    doesFileExist, getCurrentDirectory)+    ( canonicalizePath+    , doesDirectoryExist+    , doesFileExist+    , getCurrentDirectory+    ) import System.Exit (ExitCode(ExitSuccess))+#if MIN_VERSION_Cabal(3,14,0)+import System.FilePath (isDrive, takeDirectory)+#else import System.FilePath (isDrive, takeDirectory, (</>))+#endif  -- | Include this function when your setup doesn't contain any -- extra functionality.@@ -162,8 +170,10 @@ prettyLicense :: I.InstalledPackageInfo -> String prettyLicense = either prettyShow prettyShow . I.license -ft :: ShortText -> String-ft = fromShortText+#if !MIN_VERSION_Cabal(3,14,0)+interpretSymbolicPath :: Maybe () -> FilePath -> FilePath+interpretSymbolicPath _ p = p+#endif  -- -------------------------------------------------------------------------- -- -- Cabal 2.0@@ -176,28 +186,31 @@     -> LocalBuildInfo     -> IO () mkPkgInfoModulesPostConf hook args flags pkgDesc bInfo = do-    mapM_ (updatePkgInfoModule pkgDesc bInfo) $ Graph.toList $ componentGraph bInfo+    mapM_ (updatePkgInfoModule pkgDesc bInfo flags) $ Graph.toList $ componentGraph bInfo     hook args flags pkgDesc bInfo -updatePkgInfoModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()-updatePkgInfoModule pkgDesc bInfo clbInfo = do-    createDirectoryIfMissing True dirName+updatePkgInfoModule+    :: PackageDescription+    -> LocalBuildInfo+    -> ConfigFlags+    -> ComponentLocalBuildInfo+    -> IO ()+updatePkgInfoModule pkgDesc bInfo flags clbInfo = do+    createDirectoryIfMissingVerbose verbosity True dirName     moduleBytes <- pkgInfoModule moduleName cName pkgDesc bInfo     updateFile fileName moduleBytes      -- legacy module     legacyModuleBytes <- pkgInfoModule legacyModuleName cName pkgDesc bInfo     updateFile legacyFileName legacyModuleBytes-   where-    dirName = autogenComponentModulesDir bInfo clbInfo+    verbosity = fromFlag $ configVerbosity flags+    dirName = interpretSymbolicPath Nothing $ autogenComponentModulesDir bInfo clbInfo     cName = unUnqualComponentName <$> componentNameString (componentLocalName clbInfo)-     moduleName = pkgInfoModuleName-    fileName = dirName ++ "/" ++ moduleName ++ ".hs"-+    fileName = dirName </> moduleName <> ".hs"     legacyModuleName = legacyPkgInfoModuleName cName-    legacyFileName = dirName ++ "/" ++ legacyModuleName ++ ".hs"+    legacyFileName = dirName </> legacyModuleName <> ".hs"  -- -------------------------------------------------------------------------- -- -- Generate PkgInfo Module@@ -217,7 +230,7 @@  legacyPkgInfoModuleName :: Maybe String -> String legacyPkgInfoModuleName Nothing = "PkgInfo"-legacyPkgInfoModuleName (Just cn) = "PkgInfo_" ++ map tr cn+legacyPkgInfoModuleName (Just cn) = "PkgInfo_" <> map tr cn   where     tr '-' = '_'     tr c = c@@ -239,7 +252,12 @@                 then return Nothing                 else getVcsOfDir (takeDirectory canonicDir) -pkgInfoModule :: String -> Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString+pkgInfoModule+    :: String+    -> Maybe String+    -> PackageDescription+    -> LocalBuildInfo+    -> IO B.ByteString pkgInfoModule moduleName cName pkgDesc bInfo = do     (tag, revision, branch) <- getVCS >>= \case         Just Mercurial -> hgInfo@@ -302,10 +320,10 @@             , "    copyright = " <> (pack . show . copyright) pkgDesc             , ""             , "    author :: IsString a => a"-            , "    author = \"" <> (pack . ft . author) pkgDesc <> "\""+            , "    author = \"" <> (pack . fromShortText . author) pkgDesc <> "\""             , ""             , "    homepage :: IsString a => a"-            , "    homepage = \"" <> (pack . ft . homepage) pkgDesc <> "\""+            , "    homepage = \"" <> (pack . fromShortText . homepage) pkgDesc <> "\""             , ""             , "    package :: IsString a => a"             , "    package = \"" <> (pack . display . package) pkgDesc <> "\""@@ -397,4 +415,4 @@     ++ (if cr /= "" then ", " ++ cr else "")     ++ "]"   where-    cr = (unwords . words . ft . I.copyright) a+    cr = (unwords . words . fromShortText . I.copyright) a
src/Configuration/Utils/Validation.hs view
@@ -17,6 +17,7 @@ -- module Configuration.Utils.Validation ( ConfigValidation+, ConfigValidation'  -- * Networking , validateHttpOrHttpsUrl@@ -85,7 +86,8 @@ -- | A validation function. The type in the 'MonadWriter' is excpected to -- be a 'Foldable' structure for collecting warnings. ---type ConfigValidation a f = ∀ m . (MonadIO m, Functor m, Applicative m, MonadError T.Text m, MonadWriter (f T.Text) m) ⇒ a → m ()+type ConfigValidation a f = ConfigValidation' a f ()+type ConfigValidation' a f r = ∀ m . (MonadIO m, Functor m, Applicative m, MonadError T.Text m, MonadWriter (f T.Text) m) ⇒ a → m r  -- -------------------------------------------------------------------------- -- -- Networking@@ -506,4 +508,3 @@     → 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-