packages feed

configuration-tools 0.4.0 → 0.4.1

raw patch · 12 files changed

+178/−195 lines, 12 filesdep +semigroupoidsdep ~basedep ~http-clientsetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: semigroupoids

Dependency ranges changed: base, http-client

API changes (from Hackage documentation)

- Configuration.Utils.CommandLine: newtype Const a (b :: k) :: forall k. () => * -> k -> *
- Configuration.Utils.Internal.HttpsCertPolicy: instance GHC.Exception.Exception Configuration.Utils.Internal.HttpsCertPolicy.VerboseTlsException
- Configuration.Utils.Maybe: instance (Data.Aeson.Types.FromJSON.FromJSON (a -> a), Data.Aeson.Types.FromJSON.FromJSON a) => Data.Aeson.Types.FromJSON.FromJSON (GHC.Base.Maybe a -> GHC.Base.Maybe a)
+ Configuration.Utils.CommandLine: infixl 3 <|>
+ Configuration.Utils.CommandLine: newtype Const a (b :: k) :: forall k. () => Type -> k -> Type
+ Configuration.Utils.Internal.HttpsCertPolicy: instance GHC.Exception.Type.Exception Configuration.Utils.Internal.HttpsCertPolicy.VerboseTlsException
+ Configuration.Utils.Maybe: instance (Data.Aeson.Types.FromJSON.FromJSON (a -> a), Data.Aeson.Types.FromJSON.FromJSON a) => Data.Aeson.Types.FromJSON.FromJSON (GHC.Maybe.Maybe a -> GHC.Maybe.Maybe a)
+ Configuration.Utils.Monoid: pLeftSemigroupalUpdate :: Semigroup a => Parser a -> MParser a
+ Configuration.Utils.Monoid: pRightSemigroupalUpdate :: Semigroup a => Parser a -> MParser a
- Configuration.Utils.CommandLine: (<$>) :: Functor f => a -> b -> f a -> f b
+ Configuration.Utils.CommandLine: (<$>) :: Functor f => (a -> b) -> f a -> f b
- Configuration.Utils.CommandLine: (<**>) :: Applicative f => f a -> f a -> b -> f b
+ Configuration.Utils.CommandLine: (<**>) :: Applicative f => f a -> f (a -> b) -> f b
- Configuration.Utils.CommandLine: (<*>) :: Applicative f => f a -> b -> f a -> f b
+ Configuration.Utils.CommandLine: (<*>) :: Applicative f => f (a -> b) -> f a -> f b
- Configuration.Utils.CommandLine: CompletionResult :: String -> IO String -> CompletionResult
+ Configuration.Utils.CommandLine: CompletionResult :: (String -> IO String) -> CompletionResult
- Configuration.Utils.CommandLine: ParserFailure :: String -> (h, ExitCode, Int) -> ParserFailure h
+ Configuration.Utils.CommandLine: ParserFailure :: (String -> (h, ExitCode, Int)) -> ParserFailure h
- Configuration.Utils.CommandLine: abortOption :: () => ParseError -> Mod OptionFields a -> a -> Parser a -> a
+ Configuration.Utils.CommandLine: abortOption :: () => ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
- Configuration.Utils.CommandLine: class Applicative f => Alternative (f :: * -> *)
+ Configuration.Utils.CommandLine: class Applicative f => Alternative (f :: Type -> Type)
- Configuration.Utils.CommandLine: class Functor f => Applicative (f :: * -> *)
+ Configuration.Utils.CommandLine: class Functor f => Applicative (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasCompleter (f :: * -> *)
+ Configuration.Utils.CommandLine: class HasCompleter (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasMetavar (f :: * -> *)
+ Configuration.Utils.CommandLine: class HasMetavar (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasName (f :: * -> *)
+ Configuration.Utils.CommandLine: class HasName (f :: Type -> Type)
- Configuration.Utils.CommandLine: class HasValue (f :: * -> *)
+ Configuration.Utils.CommandLine: class HasValue (f :: Type -> Type)
- Configuration.Utils.CommandLine: data Mod (f :: * -> *) a
+ Configuration.Utils.CommandLine: data Mod (f :: Type -> Type) a
- Configuration.Utils.CommandLine: eitherReader :: () => String -> Either String a -> ReadM a
+ Configuration.Utils.CommandLine: eitherReader :: () => (String -> Either String a) -> ReadM a
- Configuration.Utils.CommandLine: helper :: () => Parser a -> a
+ Configuration.Utils.CommandLine: helper :: () => Parser (a -> a)
- Configuration.Utils.CommandLine: infoOption :: () => String -> Mod OptionFields a -> a -> Parser a -> a
+ Configuration.Utils.CommandLine: infoOption :: () => String -> Mod OptionFields (a -> a) -> Parser (a -> a)
- Configuration.Utils.CommandLine: liftA :: Applicative f => a -> b -> f a -> f b
+ Configuration.Utils.CommandLine: liftA :: Applicative f => (a -> b) -> f a -> f b
- Configuration.Utils.CommandLine: liftA2 :: Applicative f => a -> b -> c -> f a -> f b -> f c
+ Configuration.Utils.CommandLine: liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
- Configuration.Utils.CommandLine: liftA3 :: Applicative f => a -> b -> c -> d -> f a -> f b -> f c -> f d
+ Configuration.Utils.CommandLine: liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
- Configuration.Utils.CommandLine: maybeReader :: () => String -> Maybe a -> ReadM a
+ Configuration.Utils.CommandLine: maybeReader :: () => (String -> Maybe a) -> ReadM a
- Configuration.Utils.CommandLine: mkCompleter :: String -> IO [String] -> Completer
+ Configuration.Utils.CommandLine: mkCompleter :: (String -> IO [String]) -> Completer
- Configuration.Utils.CommandLine: newtype WrappedArrow (a :: * -> * -> *) b c
+ Configuration.Utils.CommandLine: newtype WrappedArrow (a :: Type -> Type -> Type) b c
- Configuration.Utils.CommandLine: newtype WrappedMonad (m :: * -> *) a
+ Configuration.Utils.CommandLine: newtype WrappedMonad (m :: Type -> Type) a
- Configuration.Utils.CommandLine: optional :: Alternative f => f a -> f Maybe a
+ Configuration.Utils.CommandLine: optional :: Alternative f => f a -> f (Maybe a)
- Configuration.Utils.CommandLine: overFailure :: () => ParserHelp -> ParserHelp -> ParserResult a -> ParserResult a
+ Configuration.Utils.CommandLine: overFailure :: () => (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a
- Configuration.Utils.CommandLine: showDefaultWith :: () => a -> String -> Mod f a
+ Configuration.Utils.CommandLine: showDefaultWith :: () => (a -> String) -> Mod f a
- Configuration.Utils.CommandLine: style :: () => Doc -> Doc -> Mod f a
+ Configuration.Utils.CommandLine: style :: () => (Doc -> Doc) -> Mod f a
- Configuration.Utils.Internal.HttpsCertPolicy: HttpsCertPolicy :: !Bool -> !(HashMap ServiceID Fingerprint) -> HttpsCertPolicy
+ Configuration.Utils.Internal.HttpsCertPolicy: HttpsCertPolicy :: !Bool -> !HashMap ServiceID Fingerprint -> HttpsCertPolicy
- Configuration.Utils.Internal.HttpsCertPolicy: [_certPolicyHostFingerprints] :: HttpsCertPolicy -> !(HashMap ServiceID Fingerprint)
+ Configuration.Utils.Internal.HttpsCertPolicy: [_certPolicyHostFingerprints] :: HttpsCertPolicy -> !HashMap ServiceID Fingerprint
- Configuration.Utils.Validation: validateBool :: (MonadError Text m) => Text -> Bool -> Bool -> m ()
+ Configuration.Utils.Validation: validateBool :: MonadError Text m => Text -> Bool -> Bool -> m ()
- Configuration.Utils.Validation: validateFalse :: (MonadError Text m) => Text -> Bool -> m ()
+ Configuration.Utils.Validation: validateFalse :: MonadError Text m => Text -> Bool -> m ()
- Configuration.Utils.Validation: validateTrue :: (MonadError Text m) => Text -> Bool -> m ()
+ Configuration.Utils.Validation: validateTrue :: MonadError Text m => Text -> Bool -> m ()

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4.1 (2019-05-10)+==================++* Added `pLeftSemigroupalUpdate` and `pRightSemigroupalUpdate`.+ 0.4.0 (2018-08-21) ================== @@ -210,4 +215,3 @@ ===  First release.-
Setup.hs view
@@ -1,4 +1,5 @@ -- ------------------------------------------------------ --+-- Copyright © 2019 Colin Woodbury <colin@fosskers.ca> -- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ --@@ -102,13 +103,13 @@ #define MIN_VERSION_Cabal(a,b,c) 0 #endif +import qualified Distribution.InstalledPackageInfo as I import Distribution.PackageDescription import Distribution.Simple-import Distribution.Simple.Setup-import qualified Distribution.InstalledPackageInfo as I-import Distribution.Simple.LocalBuildInfo import Distribution.Simple.BuildPaths+import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex+import Distribution.Simple.Setup import Distribution.Text  #if MIN_VERSION_Cabal(2,0,0)@@ -135,14 +136,10 @@ import Prelude hiding (readFile, writeFile)  import System.Directory-    ( doesFileExist-    , doesDirectoryExist-    , createDirectoryIfMissing-    , getCurrentDirectory-    , canonicalizePath-    )-import System.FilePath (isDrive, (</>), takeDirectory)+    (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist,+    doesFileExist, getCurrentDirectory) import System.Exit (ExitCode(ExitSuccess))+import System.FilePath (isDrive, takeDirectory, (</>))  -- | Include this function when your setup doesn't contain any -- extra functionality.@@ -466,4 +463,3 @@     ++ "]"   where     cr = (unwords . words . I.copyright) a-
configuration-tools.cabal view
@@ -1,11 +1,8 @@--- ------------------------------------------------------ ----- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com>--- Copyright © 2014-2015 AlephCloud Systems, Inc.--- ------------------------------------------------------ --+cabal-version: 1.24 -Name: configuration-tools-Version: 0.4.0-Synopsis: Tools for specifying and parsing configurations+name: configuration-tools+version: 0.4.1+synopsis: Tools for specifying and parsing configurations description:     Tools for specifying and parsing configurations     .@@ -28,20 +25,21 @@     and in the API documentation of the modules "Configuration.Utils" and     "Configuration.Utils.Setup". -Homepage: https://github.com/alephcloud/hs-configuration-tools-Bug-reports: https://github.com/alephcloud/hs-configuration-tools/issues-License: MIT-License-file: LICENSE-Author: Lars Kuhtz <lakuhtz@gmail.com>-Maintainer: Lars Kuhtz <lakuhtz@gmail.com>-Copyright:+homepage: https://github.com/alephcloud/hs-configuration-tools+bug-reports: https://github.com/alephcloud/hs-configuration-tools/issues+license: MIT+license-file: LICENSE+author: Lars Kuhtz <lakuhtz@gmail.com>+maintainer: Lars Kuhtz <lakuhtz@gmail.com>+copyright:+    (c) 2019 Colin Woodbury <colin@fosskers.ca>,     (c) 2015-2018 Lars Kuhtz <lakuhtz@gmail.com>,     (c) 2014-2015 AlephCloud, Inc.-Category: Configuration, Console-Build-type: Custom-cabal-version: 1.24+category: Configuration, Console+build-type: Custom tested-with:-      GHC==8.4.3+      GHC==8.6.5+    , GHC==8.4.3     , GHC==8.2.2     , GHC==8.0.2     , GHC==7.10.3@@ -64,19 +62,15 @@     location: https://github.com/alephcloud/hs-configuration-tools.git     branch: master -source-repository this-    type: git-    location: https://github.com/alephcloud/hs-configuration-tools.git-    tag: 0.4.0- flag remote-configs     Description: enable loading of configuration files from HTTP URLs     Default: True     Manual: True -Library+library     hs-source-dirs: src     default-language: Haskell2010+    ghc-options: -Wall      exposed-modules:         Configuration.Utils@@ -95,52 +89,52 @@             Configuration.Utils.Internal.HttpsCertPolicy      build-depends:-        Cabal >= 1.24,-        aeson >= 0.7.0.6,-        ansi-wl-pprint >= 0.6,-        attoparsec >= 0.11.3.4,-        base >= 4.8 && < 5.0,-        base-unicode-symbols >= 0.2.2.4,-        bytestring >= 0.10.0.2,-        case-insensitive >= 1.2,-        deepseq >= 1.3,-        directory >= 1.2.1.0,-        dlist >= 0.7.1,-        filepath >= 1.3.0.1,-        mtl >= 2.2,-        network-uri >= 2.6.0.1,-        optparse-applicative >= 0.11.0.2,-        process >= 1.2.0.0,-        profunctors >= 4.0.4,-        semigroups >= 0.18,-        text >= 1.0,-        transformers >= 0.4,-        unordered-containers >= 0.2.4.0,-        yaml >= 0.8.8.3+        Cabal >= 1.24+      , aeson >= 0.7.0.6+      , ansi-wl-pprint >= 0.6+      , attoparsec >= 0.11.3.4+      , base >= 4.8 && < 5+      , base-unicode-symbols >= 0.2.2.4+      , bytestring >= 0.10.0.2+      , case-insensitive >= 1.2+      , deepseq >= 1.3+      , directory >= 1.2.1.0+      , dlist >= 0.7.1+      , filepath >= 1.3.0.1+      , mtl >= 2.2+      , network-uri >= 2.6.0.1+      , optparse-applicative >= 0.11.0.2+      , process >= 1.2.0.0+      , profunctors >= 4.0.4+      , semigroups >= 0.18+      , semigroupoids >= 5.0+      , text >= 1.0+      , transformers >= 0.4+      , unordered-containers >= 0.2.4.0+      , yaml >= 0.8.8.3      if flag(remote-configs)         build-depends:-            base64-bytestring >= 1.0,-            connection >= 0.2,-            data-default >= 0.5,-            enclosed-exceptions >= 1.0,-            http-client >= 0.4,-            http-client-tls >= 0.2,-            http-types >= 0.8,-            monad-control >= 1.0,-            tls >= 1.2,-            x509 >= 1.5,-            x509-system >= 1.5,-            x509-validation >= 1.5.1+            base64-bytestring >= 1.0+          , connection >= 0.2+          , data-default >= 0.5+          , enclosed-exceptions >= 1.0+          , http-client >= 0.4.30+          , http-client-tls >= 0.2+          , http-types >= 0.8+          , monad-control >= 1.0+          , tls >= 1.2+          , x509 >= 1.5+          , x509-system >= 1.5+          , x509-validation >= 1.5.1      if flag(remote-configs)         cpp-options: -DREMOTE_CONFIGS +test-suite url-example-test+    default-language: Haskell2010     ghc-options: -Wall--Test-Suite url-example-test     type: exitcode-stdio-1.0-    default-language: Haskell2010     main-is: TestExample.hs     hs-source-dirs: examples, test @@ -151,39 +145,36 @@         Tests.MonoidConfig      build-depends:-        Cabal >= 1.24,-        base >= 4.8 && < 5.0,-        base-unicode-symbols >= 0.2.2.4,-        bytestring >= 0.10,-        configuration-tools,-        mtl >= 2.2,-        text >= 1.0,-        transformers >= 0.4,-        unordered-containers >= 0.2.4.0,-        yaml >= 0.8.8.3+        Cabal >= 1.24+      , base >= 4.8 && < 5+      , base-unicode-symbols >= 0.2.2.4+      , bytestring >= 0.10+      , configuration-tools+      , mtl >= 2.2+      , text >= 1.0+      , transformers >= 0.4+      , unordered-containers >= 0.2.4.0+      , yaml >= 0.8.8.3      if flag(remote-configs)         build-depends:-            enclosed-exceptions >= 1.0,-            http-types >= 0.8,-            monad-control >= 1.0,-            wai >= 3.0,-            warp >= 3.0,-            warp-tls >= 3.0+            enclosed-exceptions >= 1.0+          , http-types >= 0.8+          , monad-control >= 1.0+          , wai >= 3.0+          , warp >= 3.0+          , warp-tls >= 3.0          cpp-options: -DREMOTE_CONFIGS +test-suite trivial+    default-language: Haskell2010     ghc-options: -Wall--Test-Suite trivial     type: exitcode-stdio-1.0-    default-language: Haskell2010     main-is: Trivial.hs     hs-source-dirs: examples      build-depends:-        base >= 4.8 && < 5.0,-        base-unicode-symbols >= 0.2.2.4,-        configuration-tools--    ghc-options: -Wall+        base >= 4.8 && < 5+      , base-unicode-symbols >= 0.2.2.4+      , configuration-tools
examples/Trivial.hs view
@@ -2,14 +2,14 @@ -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ -- -{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UnicodeSyntax #-} -module Main-( main-) where+{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main ( main ) where+ import Configuration.Utils import PkgInfo_trivial @@ -21,4 +21,3 @@  main ∷ IO () main = runWithPkgInfoConfiguration mainInfo pkgInfo . const $ putStrLn "hello world"-
src/Configuration/Utils.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-}@@ -125,8 +124,8 @@  import Configuration.Utils.CommandLine import Configuration.Utils.ConfigFile-import qualified Configuration.Utils.Internal.ConfigFileReader as CF import Configuration.Utils.Internal+import qualified Configuration.Utils.Internal.ConfigFileReader as CF import Configuration.Utils.Maybe import Configuration.Utils.Monoid import Configuration.Utils.Operators@@ -148,7 +147,7 @@  import qualified Options.Applicative as O -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_) import Prelude.Unicode  import System.IO@@ -317,18 +316,6 @@     , _mainConfig ∷ !a     } --- | A flag that indicates that the application should output the effective--- configuration and exit.----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 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.@@ -695,4 +682,3 @@     when (any (const True) warnings) $ do         T.hPutStrLn stderr "WARNINGS:"         mapM_ (\w → T.hPutStrLn stderr $ "warning: " ⊕ w) warnings-
src/Configuration/Utils/CommandLine.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -68,7 +67,7 @@ import qualified Options.Applicative as O import qualified Options.Applicative.Builder.Internal as O -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_)  import qualified Text.ParserCombinators.ReadP as P hiding (string) @@ -265,6 +264,5 @@ eitherReadP label p s =     case [ x | (x,"") ← P.readP_to_S p (T.unpack s) ] of         [x] → Right x-        []  → Left $ "eitherReadP: no parse for " ⊕ label ⊕ " of " ⊕ s-        _  → Left $ "eitherReadP: ambigous parse for " ⊕ label ⊕ " of " ⊕ s-+        [] → Left $ "eitherReadP: no parse for " ⊕ label ⊕ " of " ⊕ s+        _ → Left $ "eitherReadP: ambigous parse for " ⊕ label ⊕ " of " ⊕ s
src/Configuration/Utils/ConfigFile.hs view
@@ -75,7 +75,7 @@ import qualified Data.Text as T import Data.Typeable -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_)  #ifdef REMOTE_CONFIGS import Configuration.Utils.Internal.HttpsCertPolicy@@ -276,8 +276,7 @@ -- Miscellaneous Utilities  dropAndUncaml ∷ Int → String → String-dropAndUncaml i l-    | length l < i + 1 = l-    | otherwise = let (h:t) = drop i l-        in toLower h : concatMap (\x → if isUpper x then "-" ⊕ [toLower x] else [x]) t-+dropAndUncaml _ "" = ""+dropAndUncaml i l = case drop i l of+    [] -> l+    (h:t) -> toLower h : concatMap (\x → if isUpper x then "-" ⊕ [toLower x] else [x]) t
src/Configuration/Utils/Internal/ConfigFileReader.hs view
@@ -43,8 +43,8 @@ import Control.Applicative import Control.DeepSeq (NFData) import Control.Monad-import Control.Monad.IO.Class import Control.Monad.Error.Class+import Control.Monad.IO.Class  import qualified Data.ByteString.Char8 as B8 import Data.Monoid.Unicode@@ -54,7 +54,7 @@  import GHC.Generics -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_) import Prelude.Unicode  #ifdef REMOTE_CONFIGS@@ -208,7 +208,7 @@     url = getConfigFile path     policy = _cfcHttpsPolicy conf     doHttp = liftIO $ do-        request ← (HTTP.parseUrl $ T.unpack url)+        request ← (HTTP.parseUrlThrow $ T.unpack url)             <&> over requestHeaders ((:) acceptHeader)         resp ← httpWithValidationPolicy request policy         let format = maybe Other contentType ∘ L.lookup HTTP.hContentType $ HTTP.responseHeaders resp@@ -220,4 +220,3 @@ requestHeaders = lens HTTP.requestHeaders $ \s a → s { HTTP.requestHeaders = a }  #endif-
src/Configuration/Utils/Internal/HttpsCertPolicy.hs view
@@ -1,7 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -41,40 +40,41 @@ import Configuration.Utils.Operators import Configuration.Utils.Validation -import Control.Exception (catches, Handler(..))-import Control.Monad.Writer hiding (mapM_)+import Control.Arrow (second)+import Control.Exception (Exception, Handler(..), catches, throwIO)+import Control.Monad.State+import Control.Monad.Writer +import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as LB+import Data.Default (def)+import qualified Data.HashMap.Strict as HM+import Data.IORef+import qualified Data.List as L import Data.Maybe import Data.Monoid.Unicode 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  import qualified Options.Applicative as O -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_) import Prelude.Unicode -import Control.Arrow (second)-import qualified Data.ByteString.Lazy as LB-import qualified Data.List as L import qualified Network.Connection as HTTP import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.TLS as HTTP-import qualified System.X509 as TLS (getSystemCertificateStore)-import qualified Data.X509.Validation as TLS (ServiceID, Fingerprint(..), getFingerprint, ValidationCacheQueryCallback) import qualified Network.TLS as TLS hiding (HashSHA256)-import Data.Default (def)-import qualified Network.TLS.Extra as TLS (ciphersuite_all)+import qualified Network.TLS.Extra as TLS++import qualified System.X509 as TLS+ import Text.Read (readEither)-import qualified Data.ByteString.Base64 as B64-import Control.Monad.State hiding (mapM_)-import qualified Data.HashMap.Strict as HM-import Control.Exception (Exception, catch, throwIO, fromException)-import Data.IORef-import qualified Data.Text.Encoding as T-import qualified Data.X509 as TLS (HashALG(HashSHA256), Certificate, SignedExact, CertificateChain(..))  -- -------------------------------------------------------------------------- -- -- HTTPS Certificate Validation Policy@@ -144,7 +144,7 @@     → HttpsCertPolicy     → IO (HTTP.Response LB.ByteString) simpleHttpWithValidationPolicy url policy = do-    request ← (HTTP.parseUrl $ T.unpack url)+    request ← HTTP.parseUrlThrow $ T.unpack url     httpWithValidationPolicy request policy  httpWithValidationPolicy@@ -154,7 +154,8 @@ httpWithValidationPolicy request policy = do     certVar ← newIORef Nothing     settings ← getSettings policy certVar-    HTTP.withManager settings (HTTP.httpLbs request) `catches`+    mgr <- HTTP.newManager settings+    HTTP.httpLbs request mgr `catches`         [ Handler $ \(e ∷ TLS.TLSException) → do             cert ← readIORef certVar             handleTlsException request cert e@@ -285,7 +286,7 @@     -- and 'TLS.connectTo' are going to overwrite this anyways.     --     tlsSettings certstore = (TLS.defaultParamsClient "" "")-        { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_all }+        { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default }         , TLS.clientShared = def             { TLS.sharedCAStore = certstore             , TLS.sharedValidationCache = validationCache@@ -325,4 +326,3 @@                     ⊕ " but got fingerprint: " ⊕ printFingerprint fingerprint       where         printFingerprint (TLS.Fingerprint f) = fromString ∘ B8.unpack ∘ B64.encode $ f-
src/Configuration/Utils/Monoid.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -13,33 +11,37 @@ -- Maintainer: Lars Kuhtz <lkuhtz@pivotmail.com> -- Stability: experimental ----- The distinction between appending on the left and appending on--- the right is important for monoids that are sensitive to ordering--- such as 'List'. It is also of relevance for monoids with set semantics--- with non-extensional equality such as `HashMap`.+-- The distinction between appending on the left and appending on the right is+-- important for monoids that are sensitive to ordering such as 'List'. It is+-- also of relevance for monoids with set semantics with non-extensional+-- equality such as `HashMap`. -- module Configuration.Utils.Monoid-( LeftMonoidalUpdate-, leftMonoidalUpdate-, fromLeftMonoidalUpdate-, pLeftMonoidalUpdate-, RightMonoidalUpdate-, rightMonoidalUpdate-, fromRightMonoidalUpdate-, pRightMonoidalUpdate-) where+  ( LeftMonoidalUpdate+  , leftMonoidalUpdate+  , fromLeftMonoidalUpdate+  , pLeftMonoidalUpdate+  , pLeftSemigroupalUpdate+  , RightMonoidalUpdate+  , rightMonoidalUpdate+  , fromRightMonoidalUpdate+  , pRightMonoidalUpdate+  , pRightSemigroupalUpdate+  ) where  import Configuration.Utils.CommandLine import Configuration.Utils.Internal -import Control.Monad.Writer hiding (mapM_)+import Control.Monad.Writer hiding (mapM_, (<>))  import Data.Aeson+import qualified Data.List.NonEmpty as NEL import Data.Semigroup+import Data.Semigroup.Foldable (fold1)  import qualified Options.Applicative.Types as O -import Prelude hiding (concatMap, mapM_, any)+import Prelude hiding (any, concatMap, mapM_) import Prelude.Unicode  -- | Update a value by appending on the left. Under normal@@ -99,6 +101,13 @@ pLeftMonoidalUpdate ∷ Monoid a ⇒ O.Parser a → MParser a pLeftMonoidalUpdate pElement = mappend ∘ mconcat ∘ reverse <$> many pElement +-- | Like `pLeftMonoidalUpdate`, but works for `Semigroup`s instead. Using this+-- parser requires the input to have at least one copy (say, for flags that can+-- be passed multiple times).+--+pLeftSemigroupalUpdate ∷ Semigroup a ⇒ O.Parser a → MParser a+pLeftSemigroupalUpdate pElement = (<>) ∘ fold1 ∘ NEL.fromList ∘ reverse <$> some 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.@@ -129,3 +138,9 @@ pRightMonoidalUpdate ∷ Monoid a ⇒ O.Parser a → MParser a pRightMonoidalUpdate pElement = flip mappend ∘ mconcat <$> many pElement +-- | Like `pRightMonoidalUpdate`, but works for `Semigroup`s instead. Using this+-- parser requires the input to have at least one copy (say, for flags that can+-- be passed multiple times).+--+pRightSemigroupalUpdate ∷ Semigroup a ⇒ O.Parser a → MParser a+pRightSemigroupalUpdate pElement = flip (<>) ∘ fold1 ∘ NEL.fromList <$> some pElement
src/Configuration/Utils/Operators.hs view
@@ -56,7 +56,7 @@ -- | Functional composition for applicative functors. -- (<*<) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c)-(<*<) a b = pure (.) <*> a <*> b+(<*<) a b = ((.) <$> a) <*> b infixr 4 <*< {-# INLINE (<*<) #-} @@ -109,4 +109,3 @@ infixr 4 ⊙ {-# INLINE (⊙) #-} {-# DEPRECATED (⊙) "use '<*<' instead" #-}-
src/Configuration/Utils/Setup.hs view
@@ -1,9 +1,12 @@ -- ------------------------------------------------------ --+-- Copyright © 2019 Colin Woodbury <colin@fosskers.ca> -- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ --  {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -102,13 +105,13 @@ #define MIN_VERSION_Cabal(a,b,c) 0 #endif +import qualified Distribution.InstalledPackageInfo as I import Distribution.PackageDescription import Distribution.Simple-import Distribution.Simple.Setup-import qualified Distribution.InstalledPackageInfo as I-import Distribution.Simple.LocalBuildInfo import Distribution.Simple.BuildPaths+import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex+import Distribution.Simple.Setup import Distribution.Text  #if MIN_VERSION_Cabal(2,0,0)@@ -135,14 +138,10 @@ import Prelude hiding (readFile, writeFile)  import System.Directory-    ( doesFileExist-    , doesDirectoryExist-    , createDirectoryIfMissing-    , getCurrentDirectory-    , canonicalizePath-    )-import System.FilePath (isDrive, (</>), takeDirectory)+    (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist,+    doesFileExist, getCurrentDirectory) import System.Exit (ExitCode(ExitSuccess))+import System.FilePath (isDrive, takeDirectory, (</>))  -- | Include this function when your setup doesn't contain any -- extra functionality.@@ -275,12 +274,11 @@  updateFile :: FilePath -> B.ByteString -> IO () updateFile fileName content = do-    doesFileExist fileName >>= \x -> if x-    then do-        oldRevisionFile <- B.readFile fileName-        when (oldRevisionFile /= content) update-    else-        update+    x <- doesFileExist fileName+    if | not x -> update+       | otherwise -> do+           oldRevisionFile <- B.readFile fileName+           when (oldRevisionFile /= content) update   where     update = B.writeFile fileName content @@ -311,7 +309,7 @@  pkgInfoModule :: String -> Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString pkgInfoModule moduleName cName pkgDesc bInfo = do-    (tag, revision, branch) <- getVCS >>= \x -> case x of+    (tag, revision, branch) <- getVCS >>= \case         Just Mercurial -> hgInfo         Just Git -> gitInfo         _ -> noVcsInfo@@ -466,4 +464,3 @@     ++ "]"   where     cr = (unwords . words . I.copyright) a-