diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build Status](https://travis-ci.org/alephcloud/hs-configuration-tools.svg?branch=master)](https://travis-ci.org/alephcloud/hs-configuration-tools) +![](https://github.com/alephcloud/hs-configuration-tools/workflows/Tests/badge.svg) [![Hackage](https://img.shields.io/hackage/v/configuration-tools.svg)](https://hackage.haskell.org/package/configuration-tools) Overview @@ -556,4 +556,3 @@ function. * Add functionality optparse-applicative that allows to group options. - diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,10 +1,12 @@ -- ------------------------------------------------------ -- -- Copyright © 2019 Colin Woodbury --- Copyright © 2015-2018 Lars Kuhtz +-- Copyright © 2015-2020 Lars Kuhtz -- 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 diff --git a/configuration-tools.cabal b/configuration-tools.cabal --- a/configuration-tools.cabal +++ b/configuration-tools.cabal @@ -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 maintainer: Lars Kuhtz copyright: - (c) 2019 Colin Woodbury , - (c) 2015-2018 Lars Kuhtz , + (c) 2019-2020 Colin Woodbury , + (c) 2015-2020 Lars Kuhtz , (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 diff --git a/examples/Example.hs b/examples/Example.hs --- a/examples/Example.hs +++ b/examples/Example.hs @@ -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 diff --git a/examples/Trivial.hs b/examples/Trivial.hs --- a/examples/Trivial.hs +++ b/examples/Trivial.hs @@ -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 diff --git a/src/Configuration/Utils.hs b/src/Configuration/Utils.hs --- a/src/Configuration/Utils.hs +++ b/src/Configuration/Utils.hs @@ -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) diff --git a/src/Configuration/Utils/CommandLine.hs b/src/Configuration/Utils/CommandLine.hs --- a/src/Configuration/Utils/CommandLine.hs +++ b/src/Configuration/Utils/CommandLine.hs @@ -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 diff --git a/src/Configuration/Utils/ConfigFile.hs b/src/Configuration/Utils/ConfigFile.hs --- a/src/Configuration/Utils/ConfigFile.hs +++ b/src/Configuration/Utils/ConfigFile.hs @@ -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 diff --git a/src/Configuration/Utils/Http.hs b/src/Configuration/Utils/Http.hs --- a/src/Configuration/Utils/Http.hs +++ b/src/Configuration/Utils/Http.hs @@ -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 diff --git a/src/Configuration/Utils/Internal/HttpsCertPolicy.hs b/src/Configuration/Utils/Internal/HttpsCertPolicy.hs --- a/src/Configuration/Utils/Internal/HttpsCertPolicy.hs +++ b/src/Configuration/Utils/Internal/HttpsCertPolicy.hs @@ -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 diff --git a/src/Configuration/Utils/Operators.hs b/src/Configuration/Utils/Operators.hs --- a/src/Configuration/Utils/Operators.hs +++ b/src/Configuration/Utils/Operators.hs @@ -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 ../ ⊙ --- -(⊙) ∷ Applicative f ⇒ f (b → c) → f (a → b) → f (a → c) -(⊙) = (<.>) -infixr 4 ⊙ -{-# INLINE (⊙) #-} -{-# DEPRECATED (⊙) "use '<*<' instead" #-} diff --git a/src/Configuration/Utils/Setup.hs b/src/Configuration/Utils/Setup.hs --- a/src/Configuration/Utils/Setup.hs +++ b/src/Configuration/Utils/Setup.hs @@ -1,6 +1,6 @@ -- ------------------------------------------------------ -- -- Copyright © 2019 Colin Woodbury --- Copyright © 2015-2018 Lars Kuhtz +-- Copyright © 2015-2020 Lars Kuhtz -- 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 diff --git a/test/TestExample.hs b/test/TestExample.hs --- a/test/TestExample.hs +++ b/test/TestExample.hs @@ -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 diff --git a/test/TestTools.hs b/test/TestTools.hs --- a/test/TestTools.hs +++ b/test/TestTools.hs @@ -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 diff --git a/test/Tests/BoolOption.hs b/test/Tests/BoolOption.hs --- a/test/Tests/BoolOption.hs +++ b/test/Tests/BoolOption.hs @@ -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) - diff --git a/test/Tests/MonoidConfig.hs b/test/Tests/MonoidConfig.hs --- a/test/Tests/MonoidConfig.hs +++ b/test/Tests/MonoidConfig.hs @@ -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