diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +0.2.6 +===== + +* For git repositories include also light-weight (non-annotated) tags + in the version description. + +* Added new function `boolReader`, `boolOption`, `fileOption`, and + `eitherReadP` to `Utils`. + +* Added new function `maybeOption` and improved documentation about + `Maybe` config values. + +* Included optimisation level into long info. + 0.2.5 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -281,7 +281,13 @@ Optional Configuration Values ----------------------------- -For configuration values of type `Maybe a`, though being sum types, we provide +For simple `Maybe` values the standard `FromJSON` instance from the aeson +package can be used along with the `..:` operator. When defining command line +option parsers with `.::` and `%::` all options are optional. When an option is +not present on the command line the default value is used. For `Maybe` values +it is therefore enough to wrap the parsed value into `Just`. + +For configuration values of type `Maybe a` where `a` is a record type we provide an orphan[^1] `FromJSON` instance of the form ~~~{.haskell} @@ -290,14 +296,18 @@ that has the following behavior: -If the parsed configuration value is 'Null' the resulting function constantly +If the parsed configuration value is `Null` the resulting function constantly returns `Nothing`. Otherwise -* the function does an pointwise update using the `FromJSON` instance for - `a -> a` when applied to `Just a` and -* the function uses the `FromJSON` instance for `a` to return the parsed `a` - value when applied to 'Nothing'. +* If the parsed configuration value is `Null` the result is `Nothing`. +* If the parsed configuration value is not `Null` then the result is + an update function that + * updates the given default value if this value is `Just x` or + * is a constant function that returns the value that is parsed + from the configuration using the `FromJSON` instance for the + configuration type. + The `FromJSON a` instance may either require that the parsed configuration fully specifies the value of `a` (and raise a failure otherwise) or the `FromJSON a` instance may do an pointwise update of a hardcoded default value based on @@ -317,6 +327,9 @@ is an issue for you, please let me know. In that case we can define a new type for optional configuration values. +The function `maybeOption` is provided for defining command line parser for +`Maybe` record values. + Package and Build Information ============================= @@ -411,7 +424,7 @@ `examples/Trivial.hs` from this package: ~~~{.shell} -trivial-0.2.3 (package configuration-tools-0.2.3 revision 83634a3) +trivial-0.2.6 (package configuration-tools-0.2.6 revision 2cc860c) Copyright (c) 2014 AlephCloud, Inc. Author: Lars Kuhtz @@ -419,11 +432,12 @@ Homepage: https://github.com/alephcloud/hs-configuration-tools Build with: ghc-7.8.3 (x86_64-osx) Build flags: +Optimisation: normal Dependencies: - Cabal-1.20.0.1 [BSD3, 2003-2006, Isaac Jones 2005-2011, Duncan Coutts] - MonadRandom-0.1.13 [OtherLicense] - aeson-0.7.0.6 [BSD3, (c) 2011-2014 Bryan O'Sullivan (c) 2011 MailRank, Inc.] + Cabal-1.20.0.2 [BSD3, 2003-2006, Isaac Jones 2005-2011, Duncan Coutts] + MonadRandom-0.3 [OtherLicense] + aeson-0.8.0.0 [BSD3, (c) 2011-2014 Bryan O'Sullivan (c) 2011 MailRank, Inc.] ansi-terminal-0.6.1.1 [BSD3] ansi-wl-pprint-0.6.7.1 [BSD3] array-0.5.0.0 [BSD3] @@ -433,15 +447,16 @@ bifunctors-4.1.1.1 [BSD3, Copyright (C) 2008-2013 Edward A. Kmett] rts-1.0 [BSD3] bytestring-0.10.4.0 [BSD3, Copyright (c) Don Stewart 2005-2009, (c) Duncan Coutts 2006-2013, (c) David Roundy 2003-2005, (c) Jasper Van der Jeugt 2010, (c) Simon Meier 2010-2013.] - comonad-4.2 [BSD3, Copyright (C) 2008-2013 Edward A. Kmett, Copyright (C) 2004-2008 Dave Menendez] - conduit-1.1.6 [MIT] + case-insensitive-1.2.0.0 [BSD3, 2011 Bas van Dijk] + comonad-4.2.2 [BSD3, Copyright (C) 2008-2014 Edward A. Kmett, Copyright (C) 2004-2008 Dave Menendez] + conduit-1.2.0.2 [MIT] containers-0.5.5.1 [BSD3] - contravariant-0.6 [BSD3, Copyright (C) 2007-2014 Edward A. Kmett] + contravariant-1.2 [BSD3, Copyright (C) 2007-2014 Edward A. Kmett] deepseq-1.3.0.2 [BSD3] directory-1.2.1.0 [BSD3] distributive-0.4.4 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] dlist-0.7.1 [BSD3, 2006-2009 Don Stewart, 2013 Sean Leather] - either-4.3.0.1 [BSD3, Copyright (C) 2008-2014 Edward A. Kmett] + either-4.3.1 [BSD3, Copyright (C) 2008-2014 Edward A. Kmett] errors-1.4.7 [BSD3, 2012, 2013 Gabriel Gonzalez] exceptions-0.6.1 [BSD3, Copyright (C) 2013-2014 Edward A. Kmett Copyright (C) 2012 Google Inc.] filepath-1.3.0.2 [BSD3] @@ -450,36 +465,37 @@ hashable-1.2.2.0 [BSD3] integer-gmp-0.5.1.0 [BSD3] lifted-base-0.2.3.0 [BSD3, (c) 2011-2012 Bas van Dijk, Anders Kaseorg] - mmorph-1.0.3 [BSD3, 2013 Gabriel Gonzalez] + mmorph-1.0.4 [BSD3, 2013 Gabriel Gonzalez] monad-control-0.3.3.0 [BSD3, (c) 2011 Bas van Dijk, Anders Kaseorg] - mtl-2.1.3.1 [BSD3] + mtl-2.2.1 [BSD3] nats-0.2 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] old-locale-1.0.0.6 [BSD3] - optparse-applicative-0.9.0 [BSD3, (c) 2012 Paolo Capriotti ] + optparse-applicative-0.11.0.1 [BSD3, (c) 2012-2014 Paolo Capriotti ] prelude-extras-0.4 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] pretty-1.1.1.1 [BSD3] primitive-0.5.3.0 [BSD3, (c) Roman Leshchinskiy 2009-2012] process-1.2.0.0 [BSD3] - profunctors-4.0.4 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] + profunctors-4.2.0.1 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] random-1.0.1.1 [BSD3] - resourcet-1.1.2.2 [BSD3] + resourcet-1.1.2.3 [BSD3] safe-0.3.6 [BSD3, Neil Mitchell 2007-2014] scientific-0.3.3.0 [BSD3] - semigroupoids-4.0.2.1 [BSD3, Copyright (C) 2011-2013 Edward A. Kmett] - semigroups-0.15.1 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] + semigroupoids-4.2 [BSD3, Copyright (C) 2011-2013 Edward A. Kmett] + semigroups-0.15.3 [BSD3, Copyright (C) 2011-2014 Edward A. Kmett] + stm-2.4.3 [BSD3] syb-0.4.2 [BSD3] tagged-0.7.2 [BSD3, 2009-2013 Edward A. Kmett] template-haskell-2.9.0.0 [BSD3] text-1.1.1.3 [BSD3, 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper] time-1.4.2 [BSD3] - transformers-0.3.0.0 [BSD3] - transformers-base-0.4.2 [BSD3, 2011 Mikhail Vorozhtsov , Bas van Dijk ] + transformers-0.4.1.0 [BSD3] + transformers-base-0.4.3 [BSD3, 2011 Mikhail Vorozhtsov , Bas van Dijk ] transformers-compat-0.3.3.4 [BSD3, Copyright (C) 2012 Edward A. Kmett] unix-2.7.0.1 [BSD3] unordered-containers-0.2.5.0 [BSD3, 2010-2014 Johan Tibell 2010 Edward Z. Yang] vector-0.10.11.0 [BSD3, (c) Roman Leshchinskiy 2008-2012] void-0.6.1 [BSD3, Copyright (C) 2008-2013 Edward A. Kmett] - yaml-0.8.8.4 [BSD3] + yaml-0.8.9.1 [BSD3] ~~~ Configuration Types for HTTP Services and Clients @@ -540,3 +556,11 @@ * Include default values in help message. +* Use 'helpDoc' to highlight "meta-options", like options that enable + optional configuration values through usage of the `maybeOption` + function. + +* Add functionality optparse-applicative that allows to group options. + +* Raise parser error for sub-ordinate "maybe" options when not enabled + the respective optional value is not enabled. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -26,7 +26,7 @@ -- -- = Usage as Setup Script -- --- There are two ways how this module can be used: +-- There are three ways how this module can be used: -- -- 1. Copy the code of this module into a file called @Setup.hs@ in the root -- directory of your package. @@ -38,7 +38,18 @@ -- > -- > import Configuration.Utils.Setup -- --- With both methods the field @Build-Type@ in the package description (cabal) file +-- 3. For usage within a more complex @Setup.hs@ script you shall import this +-- module qualified and use the 'mkPkgInfoModules' function. For example: +-- +-- > module Main (main) where +-- > +-- > import qualified Configuration.Utils.Setup as ConfTools +-- > +-- > main :: IO () +-- > main = defaultMainWithHooks (ConfTools.mkPkgInfoModules simpleUserHooks) +-- > +-- +-- With all methods the field @Build-Type@ in the package description (cabal) file -- must be set to @Custom@: -- -- > Build-Type: Custom @@ -90,7 +101,10 @@ -- [@--license@] -- prints the text of the lincense of the application and exits. -- -module Main (main) where +module Main +( main +, mkPkgInfoModules +) where import Distribution.PackageDescription import Distribution.Simple @@ -116,18 +130,52 @@ import System.Directory (doesFileExist, doesDirectoryExist, createDirectoryIfMissing) import System.Exit (ExitCode(ExitSuccess)) +-- | Include this function when your setup doesn't contain any +-- extra functionality. +-- main :: IO () -main = defaultMainWithHooks simpleUserHooks - { postConf = mkPkgInfoModules +main = defaultMainWithHooks (mkPkgInfoModules simpleUserHooks) + +-- | Modifies the given record of hooks by adding functionality that +-- creates a package info module for each component of the cabal package. +-- +-- This function is intended for usage in more complex @Setup.hs@ scripts. +-- If your setup doesn't contain any other function you can just import +-- the 'main' function from this module. +-- +-- The modules are created in the /autogen/ build directory where also the +-- @Path_@ module is created by cabal's simple build setup. This is usually the +-- directory @.\/dist\/build\/autogen@. +-- +-- For a library component the module is named just @PkgInfo@. For all other +-- components the module is named @PkgInfo_COMPONENT_NAME@ where +-- @COMPONENT_NAME@ is the name of the component with @-@ characters replaced by +-- @_@. +-- +mkPkgInfoModules + :: UserHooks + -> UserHooks +mkPkgInfoModules hooks = hooks + { postConf = mkPkgInfoModulesPostConf (postConf hooks) } + +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 - mkPkgInfoModules _ _ pkgDesc bInfo = mapM_ f . map (\(a,_,_) -> a) $ componentsConfigs bInfo - where - f cname = case cname of - CLibName -> updatePkgInfoModule Nothing pkgDesc bInfo - CExeName s -> updatePkgInfoModule (Just s) pkgDesc bInfo - CTestName s -> updatePkgInfoModule (Just s) pkgDesc bInfo - CBenchName s -> updatePkgInfoModule (Just s) pkgDesc bInfo + mkModules = mapM_ (f . \(a,_,_) -> a) $ componentsConfigs bInfo + f cname = case cname of + CLibName -> updatePkgInfoModule Nothing pkgDesc bInfo + CExeName s -> updatePkgInfoModule (Just s) pkgDesc bInfo + CTestName s -> updatePkgInfoModule (Just s) pkgDesc bInfo + CBenchName s -> updatePkgInfoModule (Just s) pkgDesc bInfo pkgInfoModuleName :: Maybe String -> String pkgInfoModuleName Nothing = "PkgInfo" @@ -144,13 +192,16 @@ where f = reverse . dropWhile isSpace getVCS :: IO (Maybe RepoType) -getVCS = do +getVCS = doesDirectoryExist ".hg" >>= \x0 -> if x0 then return (Just Mercurial) - else doesDirectoryExist ".git" >>= \x1 -> if x1 - then return (Just Git) - else return Nothing + else doesDirectoryExist ".git" >>= \x1 -> return $ if x1 + then Just Git + else Nothing +flagNameStr :: FlagName -> String +flagNameStr (FlagName s) = s + pkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString pkgInfoModule cName pkgDesc bInfo = do (tag, revision, branch) <- getVCS >>= \x -> case x of @@ -160,11 +211,11 @@ let vcsBranch = if branch == "default" || branch == "master" then "" else branch vcsVersion = intercalate "-" . filter (/= "") $ [tag, revision, vcsBranch] - flags = map fst . filter snd . configConfigurationsFlags . configFlags $ bInfo + flags = map (flagNameStr . fst) . filter snd . configConfigurationsFlags . configFlags $ bInfo licenseString <- licenseFilesText pkgDesc - return $ B.intercalate "\n" $ + return $ B.intercalate "\n" [ "{-# LANGUAGE OverloadedStrings #-}" , "{-# LANGUAGE RankNTypes #-}" , "" @@ -197,6 +248,9 @@ , " flags :: IsString a => [a]" , " flags = " <> (pack . show) flags , "" + , " optimisation :: IsString a => a" + , " optimisation = \"" <> (displayOptimisationLevel . withOptimization) bInfo <> "\"" + , "" , " arch :: IsString a => a" , " arch = \"" <> (pack . display . hostPlatform) bInfo <> "\"" , "" @@ -244,7 +298,8 @@ , " <> \"License: \" <> license <> \"\\n\"" , " <> \"Homepage: \" <> homepage <> \"\\n\"" , " <> \"Build with: \" <> compiler <> \" (\" <> arch <> \")\" <> \"\\n\"" - , " <> \"Build flags: \" <> mconcat (map (\\x -> \" \" <> x) flags) <> \"\\n\\n\"" + , " <> \"Build flags: \" <> mconcat (map (\\x -> \" \" <> x) flags) <> \"\\n\"" + , " <> \"Optimisation: \" <> optimisation <> \"\\n\\n\"" , " <> \"Dependencies:\\n\" <> mconcat (map (\\x -> \" \" <> x <> \"\\n\") dependenciesWithLicenses)" , "" , " pkgInfo :: (Monoid a, IsString a) => (a, a, a, a)" @@ -256,6 +311,10 @@ , " )" , "" ] + where + displayOptimisationLevel NoOptimisation = "none" + displayOptimisationLevel NormalOptimisation = "normal" + displayOptimisationLevel MaximumOptimisation = "maximum" updatePkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO () updatePkgInfoModule cName pkgDesc bInfo = do @@ -281,20 +340,20 @@ hgInfo :: IO (String, String, String) hgInfo = do - tag <- fmap trim $ readProcess "hg" ["id", "-r", "max(ancestors(\".\") and tag())", "-t"] "" - rev <- fmap trim $ readProcess "hg" ["id", "-i"] "" - branch <- fmap trim $ readProcess "hg" ["id", "-b"] "" + tag <- trim <$> readProcess "hg" ["id", "-r", "max(ancestors(\".\") and tag())", "-t"] "" + rev <- trim <$> readProcess "hg" ["id", "-i"] "" + branch <- trim <$> readProcess "hg" ["id", "-b"] "" return (tag, rev, branch) gitInfo :: IO (String, String, String) gitInfo = do tag <- do - (exitCode, out, _err) <- readProcessWithExitCode "git" ["describe", "--exact-match", "--abbrev=0"] "" + (exitCode, out, _err) <- readProcessWithExitCode "git" ["describe", "--exact-match", "--tags", "--abbrev=0"] "" case exitCode of ExitSuccess -> return $ trim out _ -> return "" - rev <- fmap trim $ readProcess "git" ["rev-parse", "--short", "HEAD"] "" - branch <- fmap trim $ readProcess "git" ["rev-parse", "--abbrev-ref", "HEAD"] "" + rev <- trim <$> readProcess "git" ["rev-parse", "--short", "HEAD"] "" + branch <- trim <$> readProcess "git" ["rev-parse", "--abbrev-ref", "HEAD"] "" return (tag, rev, branch) noVcsInfo :: IO (String, String, String) diff --git a/configuration-tools.cabal b/configuration-tools.cabal --- a/configuration-tools.cabal +++ b/configuration-tools.cabal @@ -3,7 +3,7 @@ -- ------------------------------------------------------ -- Name: configuration-tools -Version: 0.2.5 +Version: 0.2.6 Synopsis: Tools for specifying and parsing configurations description: Tools for specifying and parsing configurations @@ -54,7 +54,7 @@ source-repository this type: git location: https://github.com/alephcloud/hs-configuration-tools.git - tag: 0.2.5 + tag: 0.2.6 Library hs-source-dirs: src @@ -76,6 +76,7 @@ base >= 4.6 && < 5.0, base-unicode-symbols >= 0.2.2.4, bytestring >= 0.10.0.2, + case-insensitive >= 1.2, directory >= 1.2.1.0, errors >= 1.4.3, optparse-applicative >= 0.8.1, diff --git a/constraints b/constraints --- a/constraints +++ b/constraints @@ -1,6 +1,6 @@ -constraints: Cabal ==1.20.0.1, - MonadRandom ==0.1.13, - aeson ==0.7.0.6, +constraints: Cabal ==1.20.0.2, + MonadRandom ==0.3, + aeson ==0.8.0.0, ansi-terminal ==0.6.1.1, ansi-wl-pprint ==0.6.7.1, array ==0.5.0.0, @@ -9,16 +9,17 @@ base-unicode-symbols ==0.2.2.4, bifunctors ==4.1.1.1, bytestring ==0.10.4.0, - comonad ==4.2, - conduit ==1.1.6, - configuration-tools ==0.2.5, + case-insensitive ==1.2.0.0, + comonad ==4.2.2, + conduit ==1.2.0.2, + configuration-tools ==0.2.6, containers ==0.5.5.1, - contravariant ==0.6, + contravariant ==1.2, deepseq ==1.3.0.2, directory ==1.2.1.0, distributive ==0.4.4, dlist ==0.7.1, - either ==4.3.0.1, + either ==4.3.1, errors ==1.4.7, exceptions ==0.6.1, filepath ==1.3.0.2, @@ -27,34 +28,35 @@ hashable ==1.2.2.0, integer-gmp ==0.5.1.0, lifted-base ==0.2.3.0, - mmorph ==1.0.3, + mmorph ==1.0.4, monad-control ==0.3.3.0, - mtl ==2.1.3.1, + mtl ==2.2.1, nats ==0.2, old-locale ==1.0.0.6, - optparse-applicative ==0.10.0, + optparse-applicative ==0.11.0.1, prelude-extras ==0.4, pretty ==1.1.1.1, primitive ==0.5.3.0, process ==1.2.0.0, - profunctors ==4.0.4, + profunctors ==4.2.0.1, random ==1.0.1.1, - resourcet ==1.1.2.2, + resourcet ==1.1.2.3, rts ==1.0, safe ==0.3.6, scientific ==0.3.3.0, - semigroupoids ==4.0.2.1, - semigroups ==0.15.1, + semigroupoids ==4.2, + semigroups ==0.15.3, + stm ==2.4.3, syb ==0.4.2, tagged ==0.7.2, template-haskell ==2.9.0.0, text ==1.1.1.3, time ==1.4.2, - transformers ==0.3.0.0, - transformers-base ==0.4.2, + transformers ==0.4.1.0, + transformers-base ==0.4.3, transformers-compat ==0.3.3.4, unix ==2.7.0.1, unordered-containers ==0.2.5.0, vector ==0.10.11.0, void ==0.6.1, - yaml ==0.8.8.4 + yaml ==0.8.9.1 diff --git a/src/Configuration/Utils.hs b/src/Configuration/Utils.hs --- a/src/Configuration/Utils.hs +++ b/src/Configuration/Utils.hs @@ -67,12 +67,19 @@ , MParser , (.::) , (%::) +, boolReader +, boolOption +, fileOption +, eitherReadP +, module Options.Applicative -- * Parsing of Configuration Files with Default Values , setProperty , (..:) , (%.:) +, module Data.Aeson +-- * Command Line Option Parsing -- * Misc Utils , (%) , (×) @@ -87,11 +94,13 @@ , Lens -- * Configuration of Optional Values --- $maybe --- * Reexports -, module Data.Aeson -, module Options.Applicative +-- * Simple Maybe Values +-- $simplemaybe + +-- ** Record Maybe Values +-- $recordmaybe +, maybeOption ) where import Configuration.Utils.Internal @@ -102,10 +111,12 @@ import Data.Aeson.Types (Parser) import qualified Data.ByteString.Char8 as B8 import Data.Char +import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as H import Data.Maybe import Data.Monoid import Data.Monoid.Unicode +import Data.String import qualified Data.Text as T import qualified Data.Yaml as Yaml @@ -121,6 +132,8 @@ import System.IO.Unsafe (unsafePerformIO) +import qualified Text.ParserCombinators.ReadP as P + -- -------------------------------------------------------------------------- -- -- Useful Operators @@ -390,6 +403,54 @@ {-# INLINE (%.:) #-} -- -------------------------------------------------------------------------- -- +-- Command Line Option Parsing + +boolReader + ∷ (Eq a, Show a, CI.FoldCase a, IsString a, IsString e, Monoid e) + ⇒ a + → Either e Bool +boolReader x = case CI.mk x of + "true" → Right True + "false" → Right False + _ → Left $ "failed to read Boolean value " <> fromString (show x) + <> ". Expected either \"true\" or \"false\"" + +boolOption + ∷ O.Mod O.OptionFields Bool + → O.Parser Bool +#if MIN_VERSION_optparse_applicative(0,10,0) +boolOption mods = O.option (O.eitherReader boolReader) + % O.metavar "TRUE|FALSE" + <> O.completeWith ["true", "false", "TRUE", "FALSE", "True", "False"] + <> mods +#else +boolOption mods = O.nullOption + % metavar "TRUE|FALSE" + <> O.completeWith ["true", "false", "TRUE", "FALSE", "True", "False"] + <> O.eitherReader boolReader + <> mods +#endif + +fileOption + ∷ O.Mod O.OptionFields String + → O.Parser FilePath +fileOption mods = O.strOption + % O.metavar "FILE" + <> O.action "file" + <> mods + +eitherReadP + ∷ T.Text + → P.ReadP a + → T.Text + → Either T.Text a +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 + +-- -------------------------------------------------------------------------- -- -- Main Configuration data ProgramInfo α = ProgramInfo @@ -653,17 +714,12 @@ -- -------------------------------------------------------------------------- -- -- Configuration of Optional Values --- $maybe +-- $simplemaybe -- Optional configuration values are supposed to be encoded by wrapping -- the respective type with 'Maybe'. -- -- For simple values the standard 'FromJSON' instance from the aeson --- package can be used with the along with the '..:' operator. --- --- When defining command line option parsers with '.::' and '%::' all --- options are optional. When an option is not present on the command --- line the default value is used. For 'Maybe' values it is therefore --- enough to wrap the parsed value into 'Just'. +-- package can be used along with the '..:' operator. -- -- > data LogConfig = LogConfig -- > { _logLevel ∷ !Int @@ -689,6 +745,12 @@ -- > , "LogConfig" .= _logFile config -- > ] -- > +-- +-- When defining command line option parsers with '.::' and '%::' all +-- options are optional. When an option is not present on the command +-- line the default value is used. For 'Maybe' values it is therefore +-- enough to wrap the parsed value into 'Just'. +-- -- > pLogConfig ∷ MParser LogConfig -- > pLogConfig = id -- > #if MIN_VERSION_optparse-applicative(0,10,0) @@ -704,6 +766,9 @@ -- > % metavar "FILENAME" -- > % help "log file name" -- + +-- $recordmaybe +-- -- For product-type (record) 'Maybe' values the following orphan 'FromJSON' -- instance is provided: -- @@ -761,4 +826,95 @@ where f g _ Nothing = Just g f _ g (Just x) = Just (g x) + +-- | Commandline parser for record 'Maybe' values +-- +-- == Example: +-- +-- > data Setting = Setting +-- > { _setA :: !Int +-- > , _setB :: !String +-- > } +-- > deriving (Show, Read, Eq, Ord, Typeable) +-- > +-- > $(makeLenses ''Setting) +-- > +-- > defaultSetting :: Setting +-- > defaultSetting = Setting +-- > { _setA = 0 +-- > , _setB = 1 +-- > } +-- > +-- > instance ToJSON Setting where +-- > toJSON setting = object +-- > [ "a" .= _setA setting +-- > , "b" .= _setB setting +-- > ] +-- > +-- > instance FromJSON (Setting -> Setting) where +-- > parseJSON = withObject "Setting" $ \o -> id +-- > <$< setA ..: "a" % o +-- > <*< setB ..: "b" % o +-- > +-- > instance FromJSON Setting where +-- > parseJSON v = parseJSON v <*> pure defaultSetting +-- > +-- > pSetting :: MParser Setting +-- > pSetting = id +-- > <$< setA .:: option auto +-- > % short 'a' +-- > <> metavar "INT" +-- > <> help "set a" +-- > <*< setB .:: option auto +-- > % short 'b' +-- > <> metavar "INT" +-- > <> help "set b" +-- > +-- > -- | Use 'Setting' as 'Maybe' in a configuration: +-- > -- +-- > data Config = Config +-- > { _maybeSetting :: !(Maybe Setting) +-- > } +-- > deriving (Show, Read, Eq, Ord, Typeable) +-- > +-- > $(makeLenses ''Config) +-- > +-- > defaultConfig :: Config +-- > defaultConfig = Config +-- > { _maybeSetting = defaultSetting +-- > } +-- > +-- > instance ToJSON Config where +-- > toJSON config = object +-- > [ "setting" .= maybeSetting +-- > ] +-- > +-- > instance FromJSON (Config -> Config) where +-- > parseJSON = withObject "Config" $ \o -> id +-- > <$< maybeSetting %.: "setting" % o +-- > +-- > pConfig :: MParser Config +-- > pConfig = id +-- > <$< maybeSetting %:: (maybeOption defaultSetting +-- > <$> pEnableSetting +-- > <*> pSetting) +-- > where +-- > pEnableSetting = boolOption +-- > % long "setting-enable" +-- > <> value False +-- > <> help "Enable configuration flags for setting" +-- +maybeOption + :: a + -- ^ default value that is used if base configuration is 'Nothing' + -> Bool + -- ^ whether to enable this parser or not (usually is a boolean option parser) + -> (a -> a) + -- ^ update function (usually given as applicative 'MParser a') + -> Maybe a + -- ^ the base value that is updated (usually the result of parsing the configuraton file) + -> Maybe a +maybeOption _ False _ Nothing = Nothing -- not enabled +maybeOption defA True update Nothing = Just $ update defA -- disabled in config file but enabled by command line +maybeOption _ _ update (Just val) = Just $ update val -- enabled by config file and possibly by command line diff --git a/src/Configuration/Utils/Internal.hs b/src/Configuration/Utils/Internal.hs --- a/src/Configuration/Utils/Internal.hs +++ b/src/Configuration/Utils/Internal.hs @@ -28,24 +28,38 @@ -- | This is the same type as the type from the lens library with the same name. -- +-- In case it is already import from the lens package this should be hidden +-- from the import. +-- type Lens σ τ α β = Functor φ ⇒ (α → φ β) → σ → φ τ -- | This is the same type as the type from the lens library with the same name. -- +-- In case it is already import from the lens package this should be hidden +-- from the import. +-- type Lens' σ α = Lens σ σ α α lens ∷ (σ → α) → (σ → β → τ) → Lens σ τ α β lens getter setter lGetter s = setter s `fmap` lGetter (getter s) +{-# INLINE lens #-} over ∷ ((α → Identity α) → β → Identity β) → (α → α) → β → β over s f = runIdentity . s (Identity . f) +{-# INLINE over #-} set ∷ ((α → Identity α) → β → Identity β) → α → β → β set s a = runIdentity . s (const $ Identity a) +{-# INLINE set #-} -- | This is the same type as the type from the lens library with the same name. -- +-- In case it is already import from the lens package this should be hidden +-- from the import. +-- type Iso' β α = (Profunctor π, Functor φ) ⇒ π α (φ α) → π β (φ β) iso ∷ (β → α) → (α → β) → Iso' β α iso f g = dimap f (fmap g) +{-# INLINE iso #-} + 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 @@ -248,6 +248,9 @@ , " flags :: IsString a => [a]" , " flags = " <> (pack . show) flags , "" + , " optimisation :: IsString a => a" + , " optimisation = \"" <> (displayOptimisationLevel . withOptimization) bInfo <> "\"" + , "" , " arch :: IsString a => a" , " arch = \"" <> (pack . display . hostPlatform) bInfo <> "\"" , "" @@ -295,7 +298,8 @@ , " <> \"License: \" <> license <> \"\\n\"" , " <> \"Homepage: \" <> homepage <> \"\\n\"" , " <> \"Build with: \" <> compiler <> \" (\" <> arch <> \")\" <> \"\\n\"" - , " <> \"Build flags: \" <> mconcat (map (\\x -> \" \" <> x) flags) <> \"\\n\\n\"" + , " <> \"Build flags: \" <> mconcat (map (\\x -> \" \" <> x) flags) <> \"\\n\"" + , " <> \"Optimisation: \" <> optimisation <> \"\\n\\n\"" , " <> \"Dependencies:\\n\" <> mconcat (map (\\x -> \" \" <> x <> \"\\n\") dependenciesWithLicenses)" , "" , " pkgInfo :: (Monoid a, IsString a) => (a, a, a, a)" @@ -307,6 +311,10 @@ , " )" , "" ] + where + displayOptimisationLevel NoOptimisation = "none" + displayOptimisationLevel NormalOptimisation = "normal" + displayOptimisationLevel MaximumOptimisation = "maximum" updatePkgInfoModule :: Maybe String -> PackageDescription -> LocalBuildInfo -> IO () updatePkgInfoModule cName pkgDesc bInfo = do @@ -340,7 +348,7 @@ gitInfo :: IO (String, String, String) gitInfo = do tag <- do - (exitCode, out, _err) <- readProcessWithExitCode "git" ["describe", "--exact-match", "--abbrev=0"] "" + (exitCode, out, _err) <- readProcessWithExitCode "git" ["describe", "--exact-match", "--tags", "--abbrev=0"] "" case exitCode of ExitSuccess -> return $ trim out _ -> return ""