configuration-tools 0.4.2 → 0.5.0
raw patch · 17 files changed
+170/−320 lines, 17 filesdep ~Cabaldep ~basedep ~base-unicode-symbolssetup-changed
Dependency ranges changed: Cabal, base, base-unicode-symbols, optparse-applicative
Files
- CHANGELOG.md +43/−44
- README.md +1/−2
- Setup.hs +22/−79
- configuration-tools.cabal +32/−18
- examples/Example.hs +9/−13
- examples/Trivial.hs +0/−4
- src/Configuration/Utils.hs +4/−4
- src/Configuration/Utils/CommandLine.hs +5/−5
- src/Configuration/Utils/ConfigFile.hs +4/−4
- src/Configuration/Utils/Http.hs +17/−23
- src/Configuration/Utils/Internal/HttpsCertPolicy.hs +3/−3
- src/Configuration/Utils/Operators.hs +1/−28
- src/Configuration/Utils/Setup.hs +14/−73
- test/TestExample.hs +5/−9
- test/TestTools.hs +1/−1
- test/Tests/BoolOption.hs +3/−4
- test/Tests/MonoidConfig.hs +6/−6
CHANGELOG.md view
@@ -1,15 +1,33 @@-0.4.2 (2020-01-25)-==================+# configuration-tools +## 0.5.0 (2020-04-06)++#### Changed++- Support for GHC < 8.4 has been dropped.+- Support for Cabal < 2.2 has been dropped.+- Support for "Remote Configuration" has been turned off by default. It can be+ manually activated via the `remote-configs` flag.++#### Removed++- The previously deprecated `<.>` and `⊙` operators have been removed. Use `<.<`+ instead for either.++#### Deprecated++- The unicode `×` operator will be removed with the next major release. Use `%`+ instead.++## 0.4.2 (2020-01-25)+ * GHC 8.8 support. -0.4.1 (2019-05-10)-==================+## 0.4.1 (2019-05-10) * Added `pLeftSemigroupalUpdate` and `pRightSemigroupalUpdate`. -0.4.0 (2018-08-21)-==================+## 0.4.0 (2018-08-21) * Drop support for GHC < 7.10 and base < 4.8 * Drop support for Cabal < 1.24@@ -22,30 +40,25 @@ are still generated but marked deprecated. With Cabal 1.24 only the legacy behavior is available and a deprecation warning is raised. -0.3.1 (2018-03-16)-==================+## 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-=====+## 0.3.0 * Remove built in short options `-p`, `-c`, and `-i` * Support GHC-8.2 and Cabal-2.0 -0.2.15-======+## 0.2.15 * Support for http-client >= 0.5 -0.2.14-======+## 0.2.14 * Support for GHC-8 and Cabal-1.24 -0.2.13-======+## 0.2.13 * Eliminate most compiler warnings when compiling with GHC-7.10. @@ -61,22 +74,19 @@ Support detection of the version control system when the package directory and thus the cabal file is in sub-directory of the repository. -0.2.12-======+## 0.2.12 * Added support for transformers-0.3.0.0. This changes allows usage of configuration-tools along with packages that depend on ghc, which in turn depends on transformers-0.3.0.0. -0.2.11-======+## 0.2.11 * Added support for Cabal-1.18. This is supposed to make the build more robust and simplify integration with existing build infrastructure and other packages. -0.2.10-======+## 0.2.10 * Moved all internal APIs to the `Internal` name space. Exposing them in 0.2.9 was considered a bug.@@ -89,8 +99,7 @@ * Set the HTTP `accept` header for JSON and YAML when requesting remote configuration files. -0.2.9-=====+## 0.2.9 * Use tight constraint for all validation functions. Previously the constraint where unnecessarily restrictive.@@ -127,8 +136,7 @@ * Improved test suite. -0.2.8-=====+## 0.2.8 * Added validation functions for Boolean values, numeric values and orders.@@ -141,8 +149,7 @@ * Drop support for optparse-applicative < 0.10. -0.2.7-=====+## 0.2.7 * Added `view` function for lenses to `Configuration.Utils.Internal`. @@ -151,8 +158,7 @@ * Added module `Configuration.Utils.Validation` that provides primitives for validating different basic configuration values. -0.2.6-=====+## 0.2.6 * For git repositories include also light-weight (non-annotated) tags in the version description.@@ -165,28 +171,24 @@ * Included optimisation level into long info. -0.2.5-=====+## 0.2.5 * `Configuration.Utils.Setup`: export `mkPkgInfoModules` function that modifies a given `UserHooks` record to generate an `PkgInfo` module during configuration. -0.2.4.1-=======+## 0.2.4.1 * Support for optparse-applicative >= 0.10. -0.2.4-=====+## 0.2.4 * Configuration.Utils.Setup: fixed generation of `PkgInfo` module for package configurations with explicit flags. * Improved documentation for `Maybe` values. -0.2.3-=====+## 0.2.3 * Show the help options in the options summary message. @@ -197,8 +199,7 @@ * Added file `INSTALL_ON_WINDOWS.md` with installation instructions for windows to the package. -0.2.2-=====+## 0.2.2 * Add Lens `piOptionParserAndDefaultConfiguration` that gives simultaneous accesses to `piOptionParser` and `piDefaultConfiguration` which allows@@ -211,12 +212,10 @@ * Introduce operators `(<*<)`, `(>*>)`, `(<$<)`, `(>$>)` and deprecate `(⊙)` and `(<.>)`. -0.2.1-=====+## 0.2.1 * Fix build with GHC-7.6 by relaxing lower bounds on some dependencies. -0.2-===+## 0.2 First release.
README.md view
@@ -1,4 +1,4 @@-[](https://travis-ci.org/alephcloud/hs-configuration-tools)+ [](https://hackage.haskell.org/package/configuration-tools) Overview@@ -556,4 +556,3 @@ function. * Add functionality optparse-applicative that allows to group options.-
Setup.hs view
@@ -1,10 +1,12 @@ -- ------------------------------------------------------ -- -- Copyright © 2019 Colin Woodbury <colin@fosskers.ca>--- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright © 2015-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ -- {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -99,27 +101,21 @@ , mkPkgInfoModules ) where -#ifndef MIN_VERSION_Cabal-#define MIN_VERSION_Cabal(a,b,c) 0-#endif-+import qualified Distribution.Compat.Graph as Graph import qualified Distribution.InstalledPackageInfo as I import Distribution.PackageDescription+import Distribution.Pretty import Distribution.Simple 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)-import qualified Distribution.Compat.Graph as Graph import Distribution.Types.LocalBuildInfo import Distribution.Types.UnqualComponentName-#endif -#if MIN_VERSION_Cabal(2,2,0)-import Distribution.Pretty+#if MIN_VERSION_Cabal(3,2,0)+import Distribution.Utils.ShortText #endif import System.Process@@ -167,38 +163,20 @@ -- -------------------------------------------------------------------------- -- -- Compat Implementations -#if !MIN_VERSION_Cabal(2,0,0)-unFlagName :: FlagName -> String-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--#if !MIN_VERSION_Cabal(2,0,0)--- unUnqualComponentName :: UnqualComponentName -> String-unUnqualComponentName :: String -> String-unUnqualComponentName = id-#endif- prettyLicense :: I.InstalledPackageInfo -> String-#if MIN_VERSION_Cabal(2,2,0) prettyLicense = either prettyShow prettyShow . I.license++#if MIN_VERSION_Cabal(3,2,0)+ft :: ShortText -> String+ft = fromShortText #else-prettyLicense = prettyShow . I.license+ft :: String -> String+ft = id #endif -- -------------------------------------------------------------------------- -- -- Cabal 2.0 -#if MIN_VERSION_Cabal(2,0,0) mkPkgInfoModulesPostConf :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> Args@@ -231,40 +209,6 @@ legacyFileName = dirName ++ "/" ++ legacyModuleName ++ ".hs" -- -------------------------------------------------------------------------- ----- Cabal 1.24--#else--mkPkgInfoModulesPostConf- :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())- -> Args- -> ConfigFlags- -> PackageDescription- -> LocalBuildInfo- -> IO ()-mkPkgInfoModulesPostConf hook args flags pkgDesc bInfo = do- mkModules- hook args flags pkgDesc bInfo- where- mkModules = mapM_ (f . \(a,_,_) -> a) $ componentsConfigs bInfo- f cname = case cname of- CLibName -> updatePkgInfoModule Nothing pkgDesc bInfo- CExeName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo- CTestName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo- CBenchName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo--updatePkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO ()-updatePkgInfoModule cName pkgDesc bInfo = do- createDirectoryIfMissing True dirName- moduleBytes <- pkgInfoModule moduleName cName pkgDesc bInfo- updateFile fileName moduleBytes- where- dirName = autogenModulesDir bInfo- moduleName = legacyPkgInfoModuleName cName- fileName = dirName ++ "/" ++ moduleName ++ ".hs"-#endif---- -------------------------------------------------------------------------- -- -- Generate PkgInfo Module pkgInfoModuleName :: String@@ -272,12 +216,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 @@ -308,7 +251,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@@ -369,10 +312,10 @@ , " copyright = " <> (pack . show . copyright) pkgDesc , "" , " author :: IsString a => a"- , " author = \"" <> (pack . author) pkgDesc <> "\""+ , " author = \"" <> (pack . ft . author) pkgDesc <> "\"" , "" , " homepage :: IsString a => a"- , " homepage = \"" <> (pack . homepage) pkgDesc <> "\""+ , " homepage = \"" <> (pack . ft . homepage) pkgDesc <> "\"" , "" , " package :: IsString a => a" , " package = \"" <> (pack . display . package) pkgDesc <> "\""@@ -462,4 +405,4 @@ ++ (if cr /= "" then ", " ++ cr else "") ++ "]" where- cr = (unwords . words . I.copyright) a+ cr = (unwords . words . ft . I.copyright) a
configuration-tools.cabal view
@@ -1,7 +1,7 @@-cabal-version: 1.24+cabal-version: 2.2 name: configuration-tools-version: 0.4.2+version: 0.5.0 synopsis: Tools for specifying and parsing configurations description: Tools for specifying and parsing configurations@@ -32,18 +32,15 @@ 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) 2019-2020 Colin Woodbury <colin@fosskers.ca>,+ (c) 2015-2020 Lars Kuhtz <lakuhtz@gmail.com>, (c) 2014-2015 AlephCloud, Inc. category: Configuration, Console build-type: Custom tested-with:- GHC==8.8.2+ GHC==8.8.3 , GHC==8.6.5- , GHC==8.4.3- , GHC==8.2.2- , GHC==8.0.2- , GHC==7.10.3+ , GHC==8.4.4 extra-doc-files: README.md,@@ -51,8 +48,8 @@ custom-setup setup-depends:- Cabal >= 1.24,- base >= 4.8 && < 5.0,+ Cabal >= 2.2,+ base >= 4.11 && < 5.0, bytestring >= 0.10.0.2, directory >= 1.2.1.0, filepath >= 1.3.0.1,@@ -65,7 +62,7 @@ flag remote-configs Description: enable loading of configuration files from HTTP URLs- Default: True+ Default: False Manual: True library@@ -85,16 +82,23 @@ Configuration.Utils.Operators Configuration.Utils.Setup Configuration.Utils.Validation++ other-modules:+ PkgInfo++ autogen-modules:+ PkgInfo+ if flag(remote-configs) exposed-modules: Configuration.Utils.Internal.HttpsCertPolicy build-depends:- Cabal >= 1.24+ Cabal >= 2.2 , aeson >= 0.7.0.6 , ansi-wl-pprint >= 0.6 , attoparsec >= 0.11.3.4- , base >= 4.8 && < 5+ , base >= 4.11 && < 5 , base-unicode-symbols >= 0.2.2.4 , bytestring >= 0.10.0.2 , case-insensitive >= 1.2@@ -144,10 +148,14 @@ TestTools Tests.BoolOption Tests.MonoidConfig+ PkgInfo + autogen-modules:+ PkgInfo+ build-depends:- Cabal >= 1.24- , base >= 4.8 && < 5+ Cabal >= 2.2+ , base >= 4.11 && < 5 , base-unicode-symbols >= 0.2.2.4 , bytestring >= 0.10 , configuration-tools@@ -175,8 +183,14 @@ main-is: Trivial.hs hs-source-dirs: examples + other-modules:+ PkgInfo++ autogen-modules:+ PkgInfo+ build-depends:- base >= 4.8 && < 5+ base >= 4.11 && < 5 , base-unicode-symbols >= 0.2.2.4- , Cabal >= 1.24+ , Cabal >= 2.2 , configuration-tools
examples/Example.hs view
@@ -48,11 +48,7 @@ -- This assumes usage of cabal with custom Setup.hs ---#if MIN_VERSION_Cabal(2,0,0) import PkgInfo-#else-import PkgInfo_url_example_test-#endif -- | Specification of the authentication section of a URL. --@@ -84,8 +80,8 @@ instance FromJSON (Auth → Auth) where parseJSON = withObject "Auth" $ \o → id- <$< user ..: "user" × o- <*< pwd ..: "pwd" × o+ <$< user ..: "user" % o+ <*< pwd ..: "pwd" % o instance ToJSON Auth where toJSON a = object@@ -96,10 +92,10 @@ pAuth ∷ MParser Auth pAuth = id <$< user .:: strOption- × long "user"+ % long "user" ⊕ help "user name" <*< pwd .:: strOption- × long "pwd"+ % long "pwd" ⊕ help "password for user" -- | Simplified specification of an HTTP URL@@ -134,9 +130,9 @@ instance FromJSON (HttpURL → HttpURL) where parseJSON = withObject "HttpURL" $ \o → id- <$< auth %.: "auth" × o- <*< domain ..: "domain" × o- <*< path ..: "path" × o+ <$< auth %.: "auth" % o+ <*< domain ..: "domain" % o+ <*< path ..: "path" % o instance ToJSON HttpURL where toJSON a = object@@ -149,11 +145,11 @@ pHttpURL = id <$< auth %:: pAuth <*< domain .:: strOption- × long "domain"+ % long "domain" ⊕ short 'd' ⊕ help "HTTP domain" <*< path .:: strOption- × long "path"+ % long "path" ⊕ help "HTTP URL path" -- | Information about the main Application
examples/Trivial.hs view
@@ -13,11 +13,7 @@ import Configuration.Utils -#if MIN_VERSION_Cabal(2,0,0) import PkgInfo-#else-import PkgInfo_trivial-#endif instance FromJSON (() → ()) where parseJSON _ = pure id
src/Configuration/Utils.hs view
@@ -357,12 +357,12 @@ <*> mainParser where pPrintConfig = O.switch- × O.long "print-config"+ % O.long "print-config" ⊕ O.help "Print the parsed configuration to standard out and exit" ⊕ O.showDefault pConfigFile = ConfigFileRequired ∘ T.pack <$> O.strOption- × O.long "config-file"+ % O.long "config-file" ⊕ O.metavar "FILE" ⊕ O.help "Configuration file in YAML or JSON format. If more than a single config file option is present files are loaded in the order in which they appear on the command line." @@ -539,7 +539,7 @@ -- the 'O.helper' option from optparse-applicative is hidden by default -- which seems a bit weired. This option doesn't hide the access to help. nonHiddenHelper = abortOption ShowHelpText- × long "help"+ % long "help" ⊕ short 'h' ⊕ short '?' ⊕ help "Show this help message"@@ -605,7 +605,7 @@ O.customExecParser parserPrefs (mainOptions appInfo maybePkgInfo) -- Load and parse all configuration files- appConf ← cliAppConf & mainConfig `id` \a → a <$> errorT × CF.parseConfigFiles+ appConf ← cliAppConf & mainConfig `id` \a → a <$> errorT % CF.parseConfigFiles (_configFilesConfig cliAppConf) (_piDefaultConfiguration appInfo) (_configFiles cliAppConf)
src/Configuration/Utils/CommandLine.hs view
@@ -107,11 +107,11 @@ -- > pAuth ∷ MParser Auth -- > pAuth = id -- > <$< user .:: strOption--- > × long "user"+-- > % long "user" -- > ⊕ short 'u' -- > ⊕ help "user name" -- > <*< pwd .:: strOption--- > × long "pwd"+-- > % long "pwd" -- > ⊕ help "password for user" -- (.::) ∷ (Alternative f, Applicative f) ⇒ Lens' a b → f b → f (a → a)@@ -145,7 +145,7 @@ -- > pHttpURL = id -- > <$< auth %:: pAuth -- > <*< domain .:: strOption--- > × long "domain"+-- > % long "domain" -- > ⊕ short 'd' -- > ⊕ help "HTTP domain" --@@ -182,7 +182,7 @@ ∷ O.Mod O.OptionFields Bool → O.Parser Bool boolOption mods = O.option (O.eitherReader (boolReader ∷ String → Either String Bool))- × O.metavar "true|false"+ % O.metavar "true|false" ⊕ O.completeWith ["true", "false", "TRUE", "FALSE", "True", "False"] ⊕ mods @@ -258,7 +258,7 @@ ∷ O.Mod O.OptionFields String → O.Parser FilePath fileOption mods = O.strOption- × O.metavar "FILE"+ % O.metavar "FILE" ⊕ O.action "file" ⊕ mods
src/Configuration/Utils/ConfigFile.hs view
@@ -139,8 +139,8 @@ -- > -- > instance FromJSON (Auth → Auth) where -- > parseJSON = withObject "Auth" $ \o → id--- > <$< user ..: "user" × o--- > <*< pwd ..: "pwd" × o+-- > <$< user ..: "user" % o+-- > <*< pwd ..: "pwd" % o -- (..:) ∷ FromJSON b ⇒ Lens' a b → T.Text → Object → Parser (a → a) (..:) s k = setProperty s k parseJSON@@ -211,8 +211,8 @@ -- > -- > instance FromJSON (HttpURL → HttpURL) where -- > parseJSON = withObject "HttpURL" $ \o → id--- > <$< auth %.: "auth" × o--- > <*< domain ..: "domain" × o+-- > <$< auth %.: "auth" % o+-- > <*< domain ..: "domain" % o -- (%.:) ∷ FromJSON (b → b) ⇒ Lens' a b → T.Text → Object → Parser (a → a) (%.:) s k = updateProperty s k parseJSON
src/Configuration/Utils/Http.hs view
@@ -5,9 +5,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-#if __GLASGOW_HASKELL__>=708 {-# LANGUAGE OverloadedLists #-}-#endif {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -50,9 +48,7 @@ import Configuration.Utils.Validation import Control.Monad (when)-#if __GLASGOW_HASKELL__>=708 import Control.Monad.Writer.Class (tell)-#endif import qualified Data.ByteString.Char8 as B8 import qualified Data.DList as DL@@ -97,8 +93,8 @@ instance FromJSON (HttpServiceTLSConfiguration → HttpServiceTLSConfiguration) where parseJSON = withObject "HttpServiceTLSConfiguration" $ \o → id- <$< hstcCertFile ..: "cert-file" × o- <*< hstcKeyFile ..: "pem-file" × o+ <$< hstcCertFile ..: "cert-file" % o+ <*< hstcKeyFile ..: "pem-file" % o -- | This is used as default when wrapped into Maybe and --@@ -125,10 +121,10 @@ pHttpServiceTLSConfiguration ∷ String → MParser HttpServiceTLSConfiguration pHttpServiceTLSConfiguration prefix = id <$< hstcCertFile .:: strOption- × long (prefix ⊕ "cert-file")+ % long (prefix ⊕ "cert-file") ⊕ help "File with PEM encoded TLS Certificate" <*< hstcKeyFile .:: strOption- × long (prefix ⊕ "key-file")+ % long (prefix ⊕ "key-file") ⊕ help "File with PEM encoded TLS key" -- -------------------------------------------------------------------------- --@@ -174,19 +170,17 @@ validateHttpServiceConfiguration conf = do maybe (return ()) validateHttpServiceTLSConfiguration $ _hscUseTLS conf validatePort "port" $ _hscPort conf-#if __GLASGOW_HASKELL__>=708 when (_hscPort conf < 1024) $ tell ["listening on a priviledged port requires super user rights"]-#endif validateNonEmpty "host" $ _hscHost conf validateIPv4 "interface" . B8.unpack $ _hscInterface conf instance FromJSON (HttpServiceConfiguration → HttpServiceConfiguration) where parseJSON = withObject "HttpServiceConfiguration" $ \o → id- <$< hscHost ∘ bs ..: "host" × o- <*< hscPort ..: "port" × o- <*< hscInterface ∘ bs ..: "interface" × o- <*< hscUseTLS %.: "use-tls" × o+ <$< hscHost ∘ bs ..: "host" % o+ <*< hscPort ..: "port" % o+ <*< hscInterface ∘ bs ..: "interface" % o+ <*< hscUseTLS %.: "use-tls" % o where bs ∷ Iso' B8.ByteString String bs = iso B8.unpack B8.pack@@ -202,13 +196,13 @@ pHttpServiceConfiguration ∷ String → MParser HttpServiceConfiguration pHttpServiceConfiguration prefix = id <$< hscHost ∘ bs .:: strOption- × long (prefix ⊕ "host")+ % long (prefix ⊕ "host") ⊕ help "Hostname of the service" <*< hscPort .:: option auto- × long (prefix ⊕ "port")+ % long (prefix ⊕ "port") ⊕ help "Port of the service" <*< hscInterface ∘ bs .:: option auto- × long (prefix ⊕ "interface")+ % long (prefix ⊕ "interface") ⊕ help "Interface of the service" <*< (hscUseTLS %:: (fmap <$> pHttpServiceTLSConfiguration prefix)) where@@ -248,9 +242,9 @@ instance FromJSON (HttpClientConfiguration → HttpClientConfiguration) where parseJSON = withObject "HttpClientConfiguration" $ \o → id- <$< hccHost ∘ bs ..: "host" × o- <*< hccPort ..: "port" × o- <*< hccUseTLS ..: "use-tls" × o+ <$< hccHost ∘ bs ..: "host" % o+ <*< hccPort ..: "port" % o+ <*< hccUseTLS ..: "use-tls" % o where bs ∷ Iso' B8.ByteString String bs = iso B8.unpack B8.pack@@ -265,13 +259,13 @@ pHttpClientConfiguration ∷ String → MParser HttpClientConfiguration pHttpClientConfiguration serviceName = id <$< hccHost ∘ bs .:: strOption- × long (serviceName ⊕ "-host")+ % long (serviceName ⊕ "-host") ⊕ help ("Hostname of " ⊕ serviceName) <*< hccPort .:: option auto- × long (serviceName ⊕ "-port")+ % long (serviceName ⊕ "-port") ⊕ help ("Port of " ⊕ serviceName) <*< hccUseTLS .:: switch- × long (serviceName ⊕ "-use-tls")+ % long (serviceName ⊕ "-use-tls") ⊕ help ("Connect to " ⊕ serviceName ⊕ " via TLS") where bs ∷ Iso' B8.ByteString String
src/Configuration/Utils/Internal/HttpsCertPolicy.hs view
@@ -109,12 +109,12 @@ → MParser HttpsCertPolicy pHttpsCertPolicy prefix = id <$< certPolicyInsecure .:: boolOption_- × O.long (T.unpack prefix ⊕ "https-insecure")+ % O.long (T.unpack prefix ⊕ "https-insecure") ⊕ O.help "Bypass certificate validation for all HTTPS connections to all services. ONLY USE THIS WHEN YOU UNDERSTAND WHAT YOU DO."- <*< certPolicyHostFingerprints %:: pLeftMonoidalUpdate × pRule+ <*< certPolicyHostFingerprints %:: pLeftMonoidalUpdate % pRule where pRule = O.option (O.eitherReader readFingerprint)- × O.long (T.unpack prefix ⊕ "https-allow-cert")+ % O.long (T.unpack prefix ⊕ "https-allow-cert") ⊕ O.help "Unconditionally trust the certificate for connecting to the service. ONLY USE THIS WHEN YOU ARE SURE THAT THE CERTIFICATE CAN BE TRUSTED." ⊕ O.metavar "HOSTNAME:PORT:FINGERPRINT" readFingerprint = evalStateT $ do
src/Configuration/Utils/Operators.hs view
@@ -19,8 +19,6 @@ , (>*>) , (<$<) , (>$>)-, (<.>)-, (⊙) ) where -- -------------------------------------------------------------------------- --@@ -52,6 +50,7 @@ (×) = ($) infixr 5 × {-# INLINE (×) #-}+{-# DEPRECATED (×) "use '$' instead" #-} -- | Functional composition for applicative functors. --@@ -83,29 +82,3 @@ (>$>) = flip (<$<) infixr 4 >$> {-# INLINE (>$>) #-}---- | Functional composition for applicative functors.------ This is a rather popular operator. Due to conflicts (for instance with the--- lens package) it may have to be imported qualified.----(<.>) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c)-(<.>) = (<*<)-infixr 4 <.>-{-# INLINE (<.>) #-}-{-# DEPRECATED (<.>) "use '<*<' instead" #-}---- | For people who like nicely aligned code and do not mind messing with--- editor key-maps: here a version of '<.>' that uses a unicode symbol------ The hex value of the UTF-8 character ⊙ is 0x2299.------ A convenient VIM key-map is:------ > iabbrev <buffer> ../ ⊙----(⊙) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c)-(⊙) = (<.>)-infixr 4 ⊙-{-# INLINE (⊙) #-}-{-# DEPRECATED (⊙) "use '<*<' instead" #-}
src/Configuration/Utils/Setup.hs view
@@ -1,6 +1,6 @@ -- ------------------------------------------------------ -- -- Copyright © 2019 Colin Woodbury <colin@fosskers.ca>--- Copyright © 2015-2018 Lars Kuhtz <lakuhtz@gmail.com>+-- Copyright © 2015-2020 Lars Kuhtz <lakuhtz@gmail.com> -- Copyright © 2014 AlephCloud Systems, Inc. -- ------------------------------------------------------ -- @@ -101,27 +101,20 @@ , mkPkgInfoModules ) where -#ifndef MIN_VERSION_Cabal-#define MIN_VERSION_Cabal(a,b,c) 0-#endif-+import qualified Distribution.Compat.Graph as Graph import qualified Distribution.InstalledPackageInfo as I import Distribution.PackageDescription+import Distribution.Pretty import Distribution.Simple 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)-import qualified Distribution.Compat.Graph as Graph-import Distribution.Types.LocalBuildInfo import Distribution.Types.UnqualComponentName-#endif -#if MIN_VERSION_Cabal(2,2,0)-import Distribution.Pretty+#if MIN_VERSION_Cabal(3,2,0)+import Distribution.Utils.ShortText #endif import System.Process@@ -169,38 +162,20 @@ -- -------------------------------------------------------------------------- -- -- Compat Implementations -#if !MIN_VERSION_Cabal(2,0,0)-unFlagName :: FlagName -> String-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--#if !MIN_VERSION_Cabal(2,0,0)--- unUnqualComponentName :: UnqualComponentName -> String-unUnqualComponentName :: String -> String-unUnqualComponentName = id-#endif- prettyLicense :: I.InstalledPackageInfo -> String-#if MIN_VERSION_Cabal(2,2,0) prettyLicense = either prettyShow prettyShow . I.license++#if MIN_VERSION_Cabal(3,2,0)+ft :: ShortText -> String+ft = fromShortText #else-prettyLicense = prettyShow . I.license+ft :: String -> String+ft = id #endif -- -------------------------------------------------------------------------- -- -- Cabal 2.0 -#if MIN_VERSION_Cabal(2,0,0) mkPkgInfoModulesPostConf :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> Args@@ -233,40 +208,6 @@ legacyFileName = dirName ++ "/" ++ legacyModuleName ++ ".hs" -- -------------------------------------------------------------------------- ----- Cabal 1.24--#else--mkPkgInfoModulesPostConf- :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())- -> Args- -> ConfigFlags- -> PackageDescription- -> LocalBuildInfo- -> IO ()-mkPkgInfoModulesPostConf hook args flags pkgDesc bInfo = do- mkModules- hook args flags pkgDesc bInfo- where- mkModules = mapM_ (f . \(a,_,_) -> a) $ componentsConfigs bInfo- f cname = case cname of- CLibName -> updatePkgInfoModule Nothing pkgDesc bInfo- CExeName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo- CTestName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo- CBenchName s -> updatePkgInfoModule (Just $ unUnqualComponentName s) pkgDesc bInfo--updatePkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO ()-updatePkgInfoModule cName pkgDesc bInfo = do- createDirectoryIfMissing True dirName- moduleBytes <- pkgInfoModule moduleName cName pkgDesc bInfo- updateFile fileName moduleBytes- where- dirName = autogenModulesDir bInfo- moduleName = legacyPkgInfoModuleName cName- fileName = dirName ++ "/" ++ moduleName ++ ".hs"-#endif---- -------------------------------------------------------------------------- -- -- Generate PkgInfo Module pkgInfoModuleName :: String@@ -370,10 +311,10 @@ , " copyright = " <> (pack . show . copyright) pkgDesc , "" , " author :: IsString a => a"- , " author = \"" <> (pack . author) pkgDesc <> "\""+ , " author = \"" <> (pack . ft . author) pkgDesc <> "\"" , "" , " homepage :: IsString a => a"- , " homepage = \"" <> (pack . homepage) pkgDesc <> "\""+ , " homepage = \"" <> (pack . ft . homepage) pkgDesc <> "\"" , "" , " package :: IsString a => a" , " package = \"" <> (pack . display . package) pkgDesc <> "\""@@ -463,4 +404,4 @@ ++ (if cr /= "" then ", " ++ cr else "") ++ "]" where- cr = (unwords . words . I.copyright) a+ cr = (unwords . words . ft . I.copyright) a
test/TestExample.hs view
@@ -41,11 +41,7 @@ import Prelude.Unicode #endif -#if MIN_VERSION_Cabal(2,0,0) import PkgInfo-#else-import PkgInfo_url_example_test-#endif -- -------------------------------------------------------------------------- -- -- main@@ -55,7 +51,7 @@ -- run tests localResults ← sequence- × tests0+ $ tests0 ⊕ monoidUpdateTests pkgInfo ⊕ boolOptionTests pkgInfo localFileResults ← localFileTests@@ -64,7 +60,7 @@ -- report results let (successes, failures) = L.partition id- × localResults+ $ localResults ⊕ remoteResults ⊕ localFileResults ⊕ helpResults@@ -81,7 +77,7 @@ helpTests = withConfigFile Yaml config0 $ \tmpPath0 → withConfigFile Json config1Part $ \tmpPath1 → sequence- × testPrintHelp [tmpPath0, tmpPath1]+ $ testPrintHelp [tmpPath0, tmpPath1] localFileTests ∷ IO [Bool] localFileTests = concat <$> mapM run@@ -94,7 +90,7 @@ run (format1, format2, label) = withConfigFile format1 config0 $ \tmpPath0 → withConfigFile format2 config1Part $ \tmpPath1 → sequence- × testsConfigFile ("configFile-" ⊕ label) [tmpPath0, tmpPath1]+ $ testsConfigFile ("configFile-" ⊕ label) [tmpPath0, tmpPath1] ⊕ tests2Files1 ("local-" ⊕ label) [tmpPath0, tmpPath1] ⊕ tests2Files2 ("local-" ⊕ label) (tmpPath0) (tmpPath1) ⊕ tests2Files3 ("local-" ⊕ label) (tmpPath0) (tmpPath1)@@ -111,7 +107,7 @@ run (format, label) = withConfigFileServer typedConfigs textConfigs format $ sequence- × tests2Files2 ("remote-" ⊕ label) (serverUrl ⊕ "/config0") (serverUrl ⊕ "/config1")+ % tests2Files2 ("remote-" ⊕ label) (serverUrl ⊕ "/config0") (serverUrl ⊕ "/config1") ⊕ tests2Files3 ("remote-" ⊕ label) (serverUrl ⊕ "/config0") (serverUrl ⊕ "/config1") ⊕ testsInvalidUrl ⊕ testsTlsUrl
test/TestTools.hs view
@@ -233,7 +233,7 @@ app req respond = do let format = fromMaybe Other $ maybeFormat- <|> (contentType <$> L.lookup HTTP.hAccept × WAI.requestHeaders req)+ <|> (contentType <$> L.lookup HTTP.hAccept % WAI.requestHeaders req) maybeBody = LB.fromStrict <$> do p ← listToMaybe $ WAI.pathInfo req
test/Tests/BoolOption.hs view
@@ -53,15 +53,15 @@ pA ∷ MParser A pA = id <$< a .:: boolOption_- × long "a"+ % long "a" ⊕ short 'a' ⊕ help "a flag" <*< b .:: boolOption- × long "b"+ % long "b" ⊕ short 'b' ⊕ help "b flag" <*< c .:: enableDisableFlag- × long "c"+ % long "c" ⊕ long "c_" ⊕ short 'd' -- 'c' is taken by --config-file ⊕ help "c flag"@@ -191,4 +191,3 @@ runC (x ∷ Int) = runTest pkgInfo infoA ("boolOption-c1-" ⊕ sshow x) runC_ (x ∷ Int) = runTest pkgInfo infoA_ ("boolOption-c2-" ⊕ sshow x)-
test/Tests/MonoidConfig.hs view
@@ -66,13 +66,13 @@ instance FromJSON (RoutingTable → RoutingTable) where parseJSON = withObject "RoutingTable" $ \o → id- <$< routingTableMap . fromLeftMonoidalUpdate %.: "route_map" × o+ <$< routingTableMap . fromLeftMonoidalUpdate %.: "route_map" % o pRoutingTable ∷ MParser RoutingTable pRoutingTable = routingTableMap %:: pLeftMonoidalUpdate pRoute where pRoute = option (eitherReader readRoute)- × long "route"+ % long "route" ⊕ help "add a route to the routing table; the APIROUTE part must not contain a colon character" ⊕ metavar "APIROUTE:APIURL" @@ -127,12 +127,12 @@ instance FromJSON (StringConfigR → StringConfigR) where parseJSON = withObject "StringConfigR" $ \o → id- <$< stringConfigR . fromRightMonoidalUpdate %.: "string" × o+ <$< stringConfigR . fromRightMonoidalUpdate %.: "string" % o pStringConfigR ∷ MParser StringConfigR pStringConfigR = stringConfigR %:: pRightMonoidalUpdate pString where- pString = T.pack <$> strOption × long "string"+ pString = T.pack <$> strOption % long "string" -- Test cases @@ -202,12 +202,12 @@ instance FromJSON (StringConfigL → StringConfigL) where parseJSON = withObject "StringConfigL" $ \o → id- <$< stringConfigL . fromLeftMonoidalUpdate %.: "string" × o+ <$< stringConfigL . fromLeftMonoidalUpdate %.: "string" % o pStringConfigL ∷ MParser StringConfigL pStringConfigL = stringConfigL %:: pLeftMonoidalUpdate pString where- pString = T.pack <$> strOption × long "string"+ pString = T.pack <$> strOption % long "string" -- Test cases