opt-env-conf 0.4.0.5 → 0.5.0.0

raw patch · 9 files changed

+340/−184 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• opt-env-conf.cabal +1/−1
• src/OptEnvConf/Doc.hs +203/−113
• src/OptEnvConf/Lint.hs +16/−0
• src/OptEnvConf/Output.hs +8/−0
• src/OptEnvConf/Parser.hs +21/−20
• src/OptEnvConf/Reader.hs +4/−3
• src/OptEnvConf/Run.hs +11/−19
• src/OptEnvConf/Setting.hs +62/−28

@@ -1,5 +1,19 @@ # Changelog +## [0.5.0.0] - 2024-08-03++### Changed++* Made `Builder`s contain a list of `BuildInstructions` so library functions+  can pattern-match on the builders.+* `yesNoSwitch` and `enableDisableSwitch` now no longer take a default value,+  but accept default `value` builders instead.+* Renamed 'viaCodec' to 'viaStringCodec'.+* Clearer lints when using `name`.+* Clearer lint about loading configuration.+* Default values are now shown at the end but before example values in documentation.+* Proper `[--optional-option-docs]`+ ## [0.4.0.5] - 2024-07-28  ### Added

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           opt-env-conf-version:        0.4.0.5+version:        0.5.0.0 synopsis:       Settings parsing for Haskell: command-line arguments, environment variables, and configuration values. homepage:       https://github.com/NorfairKing/opt-env-conf#readme bug-reports:    https://github.com/NorfairKing/opt-env-conf/issues

@@ -1,4 +1,5 @@ {-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -42,7 +43,7 @@ import Autodocodec.Schema import Autodocodec.Yaml.Schema import Control.Monad-import Data.List (intersperse)+import Data.List (intercalate, intersperse) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe@@ -103,17 +104,21 @@   | AnyDocsAnd ![AnyDocs a]   | AnyDocsOr ![AnyDocs a]   | AnyDocsSingle !a-  deriving (Show)+  deriving (Show, Functor)  data CommandDoc a = CommandDoc   { commandDocArgument :: String,     commandDocHelp :: Help,     commandDocs :: AnyDocs a   }-  deriving (Show)+  deriving (Show, Functor)  mapMaybeDocs :: (a -> Maybe b) -> AnyDocs a -> AnyDocs b-mapMaybeDocs func = simplifyAnyDocs . go+mapMaybeDocs func = simplifyAnyDocs . mapMaybeDocs' func++-- Like mapMaybeDocs but without simplifying+mapMaybeDocs' :: (a -> Maybe b) -> AnyDocs a -> AnyDocs b+mapMaybeDocs' func = go   where     go = \case       AnyDocsCommands cs -> AnyDocsCommands $ map goCommandDoc cs@@ -131,9 +136,7 @@       AnyDocsAnd ds -> case concatMap goAnd ds of         [a] -> a         as -> AnyDocsAnd as-      AnyDocsOr ds -> case concatMap goOr ds of-        [a] -> a-        as -> AnyDocsOr as+      AnyDocsOr ds -> AnyDocsOr $ concatMap goOr ds       AnyDocsSingle v -> AnyDocsSingle v      goDoc cd = cd {commandDocs = go (commandDocs cd)}@@ -151,26 +154,27 @@       ds -> [go ds]  -- | Derive parser documentation-parserDocs :: Parser a -> AnyDocs SetDoc+--+-- API Note: We return a Maybe inside the AnyDocs so that we can keep track of hidden settings and use this information to know whether settings are optional or not.+parserDocs :: Parser a -> AnyDocs (Maybe SetDoc) parserDocs = simplifyAnyDocs . go   where-    noDocs = AnyDocsAnd []-    go :: Parser a -> AnyDocs SetDoc+    go :: Parser a -> AnyDocs (Maybe SetDoc)     go = \case-      ParserPure _ -> noDocs+      ParserPure _ -> AnyDocsSingle Nothing       ParserAp pf pa -> AnyDocsAnd [go pf, go pa]       ParserSelect p1 p2 -> AnyDocsAnd [go p1, go p2]       ParserEmpty _ -> AnyDocsOr []       ParserAlt p1 p2 -> AnyDocsOr [go p1, go p2]-      ParserMany p -> go p -- TODO: is this right?-      ParserSome p -> go p -- TODO: is this right?+      ParserMany p -> AnyDocsOr [go p, AnyDocsSingle Nothing]+      ParserSome p -> AnyDocsAnd [go p, go (ParserMany p)] -- TODO: is this right?       ParserAllOrNothing _ p -> go p       ParserCheck _ _ _ p -> go p       ParserCommands _ cs -> AnyDocsCommands $ map commandParserDocs cs       ParserWithConfig _ p1 p2 -> AnyDocsAnd [go p1, go p2] -- TODO: is this right? Maybe we want to document that it's not a pure parser?-      ParserSetting _ set -> maybe noDocs AnyDocsSingle $ settingSetDoc set+      ParserSetting _ set -> AnyDocsSingle $ settingSetDoc set -commandParserDocs :: Command a -> CommandDoc SetDoc+commandParserDocs :: Command a -> CommandDoc (Maybe SetDoc) commandParserDocs Command {..} =   CommandDoc     { commandDocArgument = commandArg,@@ -178,6 +182,9 @@       commandDocs = parserDocs commandParser     } +withoutHiddenDocs :: AnyDocs (Maybe a) -> AnyDocs a+withoutHiddenDocs = mapMaybeDocs id+ settingSetDoc :: Setting a -> Maybe SetDoc settingSetDoc Setting {..} = do   guard $ not settingHidden@@ -215,13 +222,7 @@ renderSetDocWithoutHeader :: SetDoc -> [[Chunk]] renderSetDocWithoutHeader SetDoc {..} =   concat-    [ [ defaultValueChunks dv-        | dv <- maybeToList setDocDefault-      ],-      [ exampleValuesChunks setDocExamples-        | not (null setDocExamples)-      ],-      [ unwordsChunks+    [ [ unwordsChunks           [ ["argument:"],             [mMetavarChunk setDocMetavar]           ]@@ -267,7 +268,13 @@             )             (NE.toList confs)           | confs <- maybeToList setDocConfKeys-        ]+        ],+      [ defaultValueChunks dv+        | dv <- maybeToList setDocDefault+      ],+      [ exampleValuesChunks setDocExamples+        | not (null setDocExamples)+      ]     ]  helpLines :: Help -> [[Chunk]]@@ -281,10 +288,11 @@   String ->   Version ->   String ->-  AnyDocs SetDoc ->+  AnyDocs (Maybe SetDoc) ->   [Chunk]-renderManPage progname version progDesc docs =-  let optDocs = docsToOptDocs docs+renderManPage progname version progDesc docs' =+  let docs = withHelpAndVersionDocs (Just version) docs'+      optDocs = docsToOptDocs docs       envDocs = docsToEnvDocs docs       confDocs = docsToConfDocs docs       commandDocs = docsToCommandDocs docs@@ -304,7 +312,7 @@               [".Sh ", "VERSION"],               [versionChunk version],               [".Sh ", "SYNOPSIS"],-              renderShortOptDocs progname optDocs,+              renderShortOptDocs progname $ docsToOptDocs docs',               [".Sh ", "SETTINGS"],               renderSetDocs docs             ],@@ -335,15 +343,16 @@           ]  -- | Render reference documentation-renderReferenceDocumentation :: String -> AnyDocs SetDoc -> [Chunk]-renderReferenceDocumentation progname docs =-  let optDocs = docsToOptDocs docs+renderReferenceDocumentation :: String -> AnyDocs (Maybe SetDoc) -> [Chunk]+renderReferenceDocumentation progname docs' =+  let docs = withHelpAndVersionDocs Nothing docs'+      optDocs = docsToOptDocs docs       envDocs = docsToEnvDocs docs       confDocs = docsToConfDocs docs       commandDocs = docsToCommandDocs docs    in unlinesChunks $         concat-          [ [ usageChunk : renderShortOptDocs progname optDocs,+          [ [ usageChunk : renderShortOptDocs progname (docsToOptDocs docs'),               [],               headerChunks "All settings",               renderSetDocs docs@@ -395,21 +404,36 @@       ["\n"]     ] --- | Render the output of @--help@-renderHelpPage :: String -> String -> AnyDocs SetDoc -> [Chunk]-renderHelpPage progname progDesc docs =+-- | Render the output of top-level @--help@+renderHelpPage :: String -> Version -> String -> AnyDocs (Maybe SetDoc) -> [Chunk]+renderHelpPage progname version =+  renderHelpPageHelper progname [] (Just version)++-- | Render the output of a @--help@ with at least one command+renderCommandHelpPage :: String -> [String] -> CommandDoc (Maybe SetDoc) -> [Chunk]+renderCommandHelpPage progname commandPath CommandDoc {..} =+  renderHelpPageHelper+    progname+    (commandPath ++ [commandDocArgument])+    Nothing+    commandDocHelp+    commandDocs++renderHelpPageHelper :: String -> [String] -> Maybe Version -> String -> AnyDocs (Maybe SetDoc) -> [Chunk]+renderHelpPageHelper progname' commandPath mVersion progDesc docs =   unlinesChunks $     concat-      [ [ usageChunk : renderShortOptDocs progname (docsToOptDocs docs),+      [ [ let progname = unwords $ progname' : commandPath+           in usageChunk : renderShortOptDocs progname (docsToOptDocs docs),           [],           unlinesChunks $ progDescLines progDesc         ],-        concat-          [ [ headerChunks "Available settings",-              renderSetDocs docs-            ]-            | not (nullDocs docs)-          ],+        [ headerChunks "Available settings",+          renderSetDocs $+            if null commandPath+              then withHelpAndVersionDocs mVersion docs+              else withHelpDocs docs+        ],         concat           [ [ headerChunks "Available commands",               renderCommandDocsShort docs@@ -418,37 +442,63 @@           ]       ] -renderCommandHelpPage :: String -> [String] -> CommandDoc SetDoc -> [Chunk]-renderCommandHelpPage progname commandPath CommandDoc {..} =-  renderHelpPage (unwords $ progname : commandPath ++ [commandDocArgument]) commandDocHelp commandDocs+withHelpAndVersionDocs :: Maybe Version -> AnyDocs (Maybe SetDoc) -> AnyDocs (Maybe SetDoc)+withHelpAndVersionDocs mVersion sd = simplifyAnyDocs $ AnyDocsOr [helpDocs, versionDocs mVersion, sd] -renderSetDocs :: AnyDocs SetDoc -> [Chunk]-renderSetDocs = unlinesChunks . go+withHelpDocs :: AnyDocs (Maybe SetDoc) -> AnyDocs (Maybe SetDoc)+withHelpDocs sd = simplifyAnyDocs $ AnyDocsOr [helpDocs, sd]++helpDocs :: AnyDocs (Maybe SetDoc)+helpDocs =+  AnyDocsSingle $+    Just+      SetDoc+        { setDocTryArgument = False,+          setDocTrySwitch = True,+          setDocTryOption = False,+          setDocDasheds = ["-h", "--help"],+          setDocEnvVars = Nothing,+          setDocConfKeys = Nothing,+          setDocDefault = Nothing,+          setDocExamples = [],+          setDocMetavar = Nothing,+          setDocHelp = Just "Show this help text"+        }++versionDocs :: Maybe Version -> AnyDocs (Maybe SetDoc)+versionDocs mVersion =+  AnyDocsSingle $+    Just+      SetDoc+        { setDocTryArgument = False,+          setDocTrySwitch = True,+          setDocTryOption = False,+          setDocDasheds = ["--version"],+          setDocEnvVars = Nothing,+          setDocConfKeys = Nothing,+          setDocDefault = Nothing,+          setDocExamples = [],+          setDocMetavar = Nothing,+          setDocHelp = Just $ case mVersion of+            Nothing -> "Output version information"+            Just version -> "Output version information: " <> showVersion version+        }++renderSetDocs :: AnyDocs (Maybe SetDoc) -> [Chunk]+renderSetDocs = unlinesChunks . intercalate [[]] . go . combineSetDocs . withoutHiddenDocs   where-    go :: AnyDocs SetDoc -> [[Chunk]]+    -- One section each, so we can add empty lines inbetween+    go :: AnyDocs (NonEmpty SetDoc) -> [[[Chunk]]]     go = \case       AnyDocsCommands _ -> []       AnyDocsAnd ds -> concatMap go ds-      AnyDocsOr ds -> goOr ds-      AnyDocsSingle d -> indent (renderSetDoc d)--    -- Group together settings with the same help (produced by combinators like enableDisableSwitch)-    goOr :: [AnyDocs SetDoc] -> [[Chunk]]-    goOr = \case-      [] -> []-      [d] -> go d-      (AnyDocsSingle d : ds) ->-        case setDocHelp d of-          Nothing -> go (AnyDocsSingle d) ++ goOr ds-          Just h ->-            let (sds, rest) = goSameHelp h ds-             in concat-                  [ indent $ renderSetDocHeader (Just h),-                    indent $ concatMap renderSetDocWithoutHeader $ d : sds,-                    [[] | not (null rest)],-                    goOr rest-                  ]-      (d : ds) -> go d ++ goOr ds+      AnyDocsOr ds -> concatMap go ds+      AnyDocsSingle (d :| ds) ->+        [ concat+            [ indent $ renderSetDocHeader (setDocHelp d),+              indent $ concatMap renderSetDocWithoutHeader (d : ds)+            ]+        ]      goSameHelp :: Help -> [AnyDocs SetDoc] -> ([SetDoc], [AnyDocs SetDoc])     goSameHelp h = \case@@ -461,8 +511,31 @@           else ([], AnyDocsSingle d : ds)       ds -> ([], ds) -renderCommandDocs :: AnyDocs SetDoc -> [Chunk]-renderCommandDocs = unlinesChunks . go True+    -- Group together settings with the same help (produced by combinators like enableDisableSwitch)+    combineSetDocs :: AnyDocs SetDoc -> AnyDocs (NonEmpty SetDoc)+    combineSetDocs = go'+      where+        go' :: AnyDocs SetDoc -> AnyDocs (NonEmpty SetDoc)+        go' = \case+          AnyDocsCommands _ -> AnyDocsCommands [] -- Don't care about commands here+          AnyDocsOr ds -> AnyDocsOr $ goOr' ds+          AnyDocsAnd ds -> AnyDocsAnd $ map go' ds+          AnyDocsSingle d -> AnyDocsSingle (d :| [])+        goOr' :: [AnyDocs SetDoc] -> [AnyDocs (NonEmpty SetDoc)]+        goOr' = \case+          [] -> []+          [d] -> [go' d]+          (AnyDocsSingle d : ds) ->+            case setDocHelp d of+              Nothing -> go' (AnyDocsSingle d) : goOr' ds+              Just h ->+                let (sds, rest) = goSameHelp h ds+                    ne = d :| sds+                 in AnyDocsSingle ne : goOr' rest+          (d : ds) -> go' d : goOr' ds++renderCommandDocs :: AnyDocs (Maybe SetDoc) -> [Chunk]+renderCommandDocs = unlinesChunks . go True . withoutHiddenDocs   where     go :: Bool -> AnyDocs SetDoc -> [[Chunk]]     go isTopLevel = \case@@ -514,8 +587,8 @@           else ([], AnyDocsSingle d : ds)       ds -> ([], ds) -renderCommandDocsShort :: AnyDocs SetDoc -> [Chunk]-renderCommandDocsShort = layoutAsTable . go+renderCommandDocsShort :: AnyDocs (Maybe SetDoc) -> [Chunk]+renderCommandDocsShort = layoutAsTable . go . withoutHiddenDocs   where     go :: AnyDocs SetDoc -> [[[Chunk]]]     go = \case@@ -528,11 +601,11 @@     goCommand CommandDoc {..} =       [indent [[commandChunk commandDocArgument], [helpChunk commandDocHelp]]] -parserOptDocs :: Parser a -> AnyDocs OptDoc+parserOptDocs :: Parser a -> AnyDocs (Maybe OptDoc) parserOptDocs = docsToOptDocs . parserDocs -docsToOptDocs :: AnyDocs SetDoc -> AnyDocs OptDoc-docsToOptDocs = mapMaybeDocs setDocOptDoc+docsToOptDocs :: AnyDocs (Maybe SetDoc) -> AnyDocs (Maybe OptDoc)+docsToOptDocs = mapMaybeDocs (>>= Just . setDocOptDoc)  setDocOptDoc :: SetDoc -> Maybe OptDoc setDocOptDoc SetDoc {..} = do@@ -548,47 +621,64 @@   pure OptDoc {..}  -- | Render short-form documentation of options-renderShortOptDocs :: String -> AnyDocs OptDoc -> [Chunk]-renderShortOptDocs progname = unwordsChunks . (\cs -> [[progNameChunk progname], cs]) . go+renderShortOptDocs :: String -> AnyDocs (Maybe OptDoc) -> [Chunk]+renderShortOptDocs progname = unwordsChunks . (\cs -> [[progNameChunk progname], cs]) . fromMaybe [] . go False   where-    go :: AnyDocs OptDoc -> [Chunk]-    go = \case-      AnyDocsCommands _ -> ["COMMAND"]-      AnyDocsAnd ds -> unwordsChunks $ map go ds-      AnyDocsOr ds -> renderOrChunks $ map go ds-      AnyDocsSingle OptDoc {..} ->-        unwordsChunks $-          concat-            [ [ [mMetavarChunk optDocMetavar]-                | optDocTryArgument-              ],-              [ concat $ maybeToList $ dashedChunks optDocDasheds-                | optDocTrySwitch-              ],-              [ concat-                  [ concat $ maybeToList $ dashedChunks optDocDasheds,-                    [" ", mMetavarChunk optDocMetavar]+    withoutNothings =+      filter+        ( \case+            AnyDocsSingle Nothing -> False+            AnyDocsAnd [] -> False+            AnyDocsOr [] -> False+            _ -> True+        )+    go ::+      -- Need parens+      Bool ->+      AnyDocs (Maybe OptDoc) ->+      Maybe [Chunk]+    go b =+      \case+        AnyDocsCommands _ -> Just ["COMMAND"]+        AnyDocsAnd ds ->+          case mapMaybe (go False) (withoutNothings ds) of+            [] -> Nothing+            [c] -> Just c+            cs -> Just $ (if b then parenthesise else id) $ unwordsChunks cs+        AnyDocsOr ds ->+          case mapMaybe (go False) (withoutNothings ds) of+            [] -> Nothing+            cs -> Just $ bracketise $ unwordsChunks $ intersperse [orChunk] cs+        AnyDocsSingle mOd -> case mOd of+          Nothing -> Nothing+          Just OptDoc {..} ->+            Just+              $ ( if isJust optDocDefault+                    then bracketise+                    else id+                )+              $ unwordsChunks+              $ concat+                [ [ [mMetavarChunk optDocMetavar]+                    | optDocTryArgument+                  ],+                  [ concat $ maybeToList $ dashedChunks optDocDasheds+                    | optDocTrySwitch+                  ],+                  [ concat+                      [ concat $ maybeToList $ dashedChunks optDocDasheds,+                        [" ", mMetavarChunk optDocMetavar]+                      ]+                    | optDocTryOption                   ]-                | optDocTryOption-              ]-            ]--renderOrChunks :: [[Chunk]] -> [Chunk]-renderOrChunks os =-  unwordsChunks $-    intersperse [orChunk] $-      map parenthesise os-  where-    parenthesise :: [Chunk] -> [Chunk]-    parenthesise [c] = [c]-    parenthesise cs = fore cyan "(" : cs ++ [fore cyan ")"]+                ]  orChunk :: Chunk orChunk = fore cyan "|"  -- | Render long-form documentation of options-renderLongOptDocs :: AnyDocs OptDoc -> [Chunk]-renderLongOptDocs = unlinesChunks . go+renderLongOptDocs :: AnyDocs (Maybe OptDoc) -> [Chunk]+renderLongOptDocs = unlinesChunks . go . withoutHiddenDocs   where     go :: AnyDocs OptDoc -> [[Chunk]]     go = \case@@ -635,8 +725,8 @@ parserEnvDocs :: Parser a -> AnyDocs EnvDoc parserEnvDocs = docsToEnvDocs . parserDocs -docsToEnvDocs :: AnyDocs SetDoc -> AnyDocs EnvDoc-docsToEnvDocs = mapMaybeDocs setDocEnvDoc+docsToEnvDocs :: AnyDocs (Maybe SetDoc) -> AnyDocs EnvDoc+docsToEnvDocs = mapMaybeDocs (>>= setDocEnvDoc)  setDocEnvDoc :: SetDoc -> Maybe EnvDoc setDocEnvDoc SetDoc {..} = do@@ -678,8 +768,8 @@ parserConfDocs :: Parser a -> AnyDocs ConfDoc parserConfDocs = docsToConfDocs . parserDocs -docsToConfDocs :: AnyDocs SetDoc -> AnyDocs ConfDoc-docsToConfDocs = mapMaybeDocs setDocConfDoc+docsToConfDocs :: AnyDocs (Maybe SetDoc) -> AnyDocs ConfDoc+docsToConfDocs = mapMaybeDocs (>>= setDocConfDoc)  setDocConfDoc :: SetDoc -> Maybe ConfDoc setDocConfDoc SetDoc {..} = do@@ -692,7 +782,7 @@ settingConfDoc :: Setting a -> Maybe ConfDoc settingConfDoc = settingSetDoc >=> setDocConfDoc -docsToCommandDocs :: AnyDocs SetDoc -> [CommandDoc SetDoc]+docsToCommandDocs :: AnyDocs (Maybe SetDoc) -> [CommandDoc (Maybe SetDoc)] docsToCommandDocs = \case   AnyDocsCommands cs -> cs   AnyDocsAnd ds -> concatMap docsToCommandDocs ds

@@ -131,6 +131,8 @@           ]         LintErrorNoReaderForOption ->           [ [ functionChunk "option",+              " or ",+              functionChunk "name",               " has no ",               functionChunk "reader",               "."@@ -147,6 +149,8 @@           ]         LintErrorNoMetavarForOption ->           [ [ functionChunk "option",+              " or ",+              functionChunk "name",               " has no ",               functionChunk "metavar",               "."@@ -174,6 +178,8 @@           ]         LintErrorNoReaderForEnvVar ->           [ [ functionChunk "env",+              " or ",+              functionChunk "name",               " has no ",               functionChunk "reader",               "."@@ -181,6 +187,8 @@           ]         LintErrorNoMetavarForEnvVar ->           [ [ functionChunk "env",+              " or ",+              functionChunk "name",               " has no ",               functionChunk "metavar",               "."@@ -201,7 +209,15 @@           ]         LintErrorConfigWithoutLoad ->           [ [ functionChunk "conf",+              " or ",+              functionChunk "name",               " was called with no way to load configuration."+            ],+            [ "You can load configuration with ",+              functionChunk "withConfig",+              ", or explicitly not load any configuration with ",+              functionChunk "withoutConfig",+              "."             ]           ]         LintErrorManyInfinite ->

@@ -85,3 +85,11 @@  indent :: [[Chunk]] -> [[Chunk]] indent = map ("  " :)++parenthesise :: [Chunk] -> [Chunk]+parenthesise [c] = [c]+parenthesise cs = fore cyan "(" : cs ++ [fore cyan ")"]++bracketise :: [Chunk] -> [Chunk]+bracketise [c] = [fore cyan "[", c, fore cyan "]"]+bracketise cs = fore cyan "[" : cs ++ [fore cyan "]"]

@@ -728,35 +728,33 @@  -- | Define a setting for a 'Bool' with a given default value. ----- If you pass in `long` values, it will have @--foobar@ and @--no-foobar@ switches.--- If you pass in `env` values, it will read those environment variables too.--- If you pass in `conf` values, it will read those configuration values too.+-- If you pass in 'long' values, it will have @--foobar@ and @--no-foobar@ switches.+-- If you pass in 'env' values, it will read those environment variables too.+-- If you pass in 'conf' values, it will read those configuration values too.+-- If you pass in a 'value' value, it will use that as the default value. yesNoSwitch ::   (HasCallStack) =>-  -- | Default value-  Bool ->   -- | Builders   [Builder Bool] ->   Parser Bool-yesNoSwitch defaultBool builders =+yesNoSwitch builders =   withFrozenCallStack $-    makeDoubleSwitch "" "no-" "[no-]" defaultBool builders+    makeDoubleSwitch "" "no-" "[no-]" builders  -- | Define a setting for a 'Bool' with a given default value. ----- If you pass in `long` values, it will have @--enable-foobar@ and @--disable-foobar@ switches.--- If you pass in `env` values, it will read those environment variables too.--- If you pass in `conf` values, it will read those configuration values too.+-- If you pass in 'long' values, it will have @--enable-foobar@ and @--disable-foobar@ switches.+-- If you pass in 'env' values, it will read those environment variables too.+-- If you pass in 'conf' values, it will read those configuration values too.+-- If you pass in a 'value' value, it will use that as the default value. enableDisableSwitch ::   (HasCallStack) =>-  -- | Default value-  Bool ->   -- | Builders   [Builder Bool] ->   Parser Bool-enableDisableSwitch defaultBool builders =+enableDisableSwitch builders =   withFrozenCallStack $-    makeDoubleSwitch "enable-" "disable-" "(enable|disable)-" defaultBool builders+    makeDoubleSwitch "enable-" "disable-" "(enable|disable)-" builders  makeDoubleSwitch ::   (HasCallStack) =>@@ -766,12 +764,10 @@   String ->   -- | Prefix for the documented 'long's   String ->-  -- | Default nvnalue-  Bool ->   -- | Builders   [Builder Bool] ->   Parser Bool-makeDoubleSwitch truePrefix falsePrefix helpPrefix defaultBool builders =+makeDoubleSwitch truePrefix falsePrefix helpPrefix builders =   withFrozenCallStack $     choice $       catMaybes@@ -780,11 +776,16 @@           Just parseEnableSwitch,           parseEnv,           parseConfigVal,-          Just $ pure defaultBool+          parseDefaultVal         ]   where-    s = buildSetting builders     mLoc = snd <$> listToMaybe (getCallStack callStack)+    s = buildSetting builders+    parseDefaultVal :: Maybe (Parser Bool)+    parseDefaultVal = do+      (dv, _) <- settingDefaultValue s+      pure $ pure dv+     parseEnableSwitch :: Parser Bool     parseEnableSwitch =       ParserSetting mLoc $@@ -865,7 +866,7 @@           { settingDasheds = mapMaybe (prefixDashedLong helpPrefix) (settingDasheds s),             settingReaders = [],             settingTryArgument = False,-            settingSwitchValue = Just defaultBool, -- Unused+            settingSwitchValue = Just True, -- Unused             settingTryOption = False,             settingEnvVars = Nothing,             settingConfigVals = Nothing,

@@ -12,7 +12,7 @@     str,     auto,     exists,-    viaCodec,+    viaStringCodec,      -- * Constructing your own reader     maybeReader,@@ -88,8 +88,9 @@ exists :: Reader Bool exists = Reader $ const $ pure True -viaCodec :: (HasCodec a) => Reader a-viaCodec = eitherReader $ parseEither $ parseJSONViaCodec . JSON.String . T.pack+-- | Read a value as if it were specified as a 'String' and parsed via the given 'Codec'.+viaStringCodec :: (HasCodec a) => Reader a+viaStringCodec = eitherReader $ parseEither $ parseJSONViaCodec . JSON.String . T.pack  -- | Turn a 'Maybe' parsing function into a 'Reader' maybeReader :: (String -> Maybe a) -> Reader a

@@ -105,8 +105,7 @@       hPutChunksLocaleWith tc stderr $ renderLintErrors errs       exitFailure     Nothing -> do-      let p' = internalParser version p-      let docs = parserDocs p'+      let docs = parserDocs p        mDebugMode <-         if debugMode@@ -130,7 +129,7 @@             Right mCommandDoc -> do               tc <- getTerminalCapabilitiesFromHandle stdout               hPutChunksLocaleWith tc stdout $ case mCommandDoc of-                Nothing -> renderHelpPage progname progDesc docs+                Nothing -> renderHelpPage progname version progDesc docs                 Just (path, cDoc) -> renderCommandHelpPage progname path cDoc               exitSuccess         else do@@ -152,6 +151,7 @@                   hPutChunksLocaleWith tc stdout ["Settings parsed successfully."]                   exitSuccess             else do+              let p' = internalParser p               errOrResult <-                 runParserOn                   mDebugMode@@ -165,7 +165,6 @@                   hPutChunksLocaleWith tc stderr $ renderErrors errs                   exitFailure                 Right i -> case i of-                  ShowHelp -> die "unreachable, this option is only here for documentation."                   ShowVersion -> do                     progname <- getProgName                     tc <- getTerminalCapabilitiesFromHandle stdout@@ -204,8 +203,7 @@ -- Internal structure to help us do what the framework -- is supposed to. data Internal a-  = ShowHelp-  | ShowVersion+  = ShowVersion   | RenderMan   | RenderDocumentation   | RenderNixosOptions@@ -221,19 +219,13 @@       ![String]   | ParsedNormally !a -internalParser :: Version -> Parser a -> Parser (Internal a)-internalParser version p =+internalParser :: Parser a -> Parser (Internal a)+internalParser p =   choice     [ setting-        [ switch ShowHelp,-          short 'h',-          long "help",-          help "Show this help text"-        ],-      setting         [ switch ShowVersion,           long "version",-          help $ "Output version information: " <> showVersion version+          hidden         ],       setting         [ switch RenderMan,@@ -653,7 +645,7 @@                                                   pure Nothing                                                 Just a -> do                                                   debug-                                                    [ "set based on config value:",+                                                    [ "set based on config value: ",                                                       chunk $ T.pack $ show v                                                     ]                                                   pure $ Just a@@ -721,7 +713,7 @@   Maybe TerminalCapabilities ->   Args ->   Parser a ->-  IO (Either (NonEmpty ParseError) (Maybe ([String], CommandDoc SetDoc)))+  IO (Either (NonEmpty ParseError) (Maybe ([String], CommandDoc (Maybe SetDoc)))) runHelpParser mDebugMode args parser = do   let ppState =         PPState@@ -743,9 +735,9 @@       Success mDocs -> Right mDocs   where     -- We try to parse the commands as deep as possible and ignore everything else.-    go' :: [String] -> Parser a -> PP (Maybe ([String], CommandDoc SetDoc))+    go' :: [String] -> Parser a -> PP (Maybe ([String], CommandDoc (Maybe SetDoc)))     go' path =-      let go :: Parser a -> PP (Maybe ([String], CommandDoc SetDoc))+      let go :: Parser a -> PP (Maybe ([String], CommandDoc (Maybe SetDoc)))           go = go' path        in \case             ParserPure _ -> do

@@ -30,6 +30,7 @@     shownExample,     hidden,     Builder (..),+    BuildInstruction (..),      -- * Internal     showSettingABit,@@ -44,6 +45,7 @@ import Autodocodec import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE+import Data.Maybe import OptEnvConf.Args (Dashed (..)) import OptEnvConf.Casing import OptEnvConf.Reader@@ -156,30 +158,64 @@       . showListWith func as  -- | Builder for a 'Setting'-newtype Builder a = Builder {unBuilder :: Setting a -> Setting a}+newtype Builder a = Builder {unBuilder :: [BuildInstruction a]} +data BuildInstruction a+  = BuildAddHelp !String+  | BuildSetMetavar !String+  | BuildTryArgument+  | BuildTryOption+  | BuildSetSwitchValue !a+  | BuildAddReader !(Reader a)+  | BuildAddLong !(NonEmpty Char)+  | BuildAddShort !Char+  | BuildAddEnv !String+  | BuildAddConf !(ConfigValSetting a)+  | BuildSetDefault !a !String+  | BuildAddExample !String+  | BuildSetHidden++applyBuildInstructions :: [BuildInstruction a] -> Setting a -> Setting a+applyBuildInstructions is s = foldr applyBuildInstruction s is++applyBuildInstruction :: BuildInstruction a -> Setting a -> Setting a+applyBuildInstruction bi s = case bi of+  BuildAddHelp h -> s {settingHelp = Just $ maybe h (<> h) (settingHelp s)}+  BuildSetMetavar mv -> s {settingMetavar = Just mv}+  BuildTryArgument -> s {settingTryArgument = True}+  BuildTryOption -> s {settingTryOption = True}+  BuildSetSwitchValue a -> s {settingSwitchValue = Just a}+  BuildAddReader r -> s {settingReaders = r : settingReaders s}+  BuildAddLong l -> s {settingDasheds = DashedLong l : settingDasheds s}+  BuildAddShort c -> s {settingDasheds = DashedShort c : settingDasheds s}+  BuildAddEnv v -> s {settingEnvVars = Just $ maybe (v :| []) (v <|) $ settingEnvVars s}+  BuildAddConf t -> s {settingConfigVals = Just $ maybe (t :| []) (t <|) $ settingConfigVals s}+  BuildSetDefault a shown -> s {settingDefaultValue = Just (a, shown)}+  BuildAddExample e -> s {settingExamples = e : settingExamples s}+  BuildSetHidden -> s {settingHidden = True}+ instance Semigroup (Builder f) where-  (<>) (Builder f1) (Builder f2) = Builder (f1 . f2)+  (<>) (Builder f1) (Builder f2) = Builder (f1 <> f2)  instance Monoid (Builder f) where-  mempty = Builder id+  mempty = Builder []   mappend = (<>)  -- | Complete a 'Builder' into a 'Setting' completeBuilder :: Builder a -> Setting a-completeBuilder b = unBuilder b emptySetting+completeBuilder b = applyBuildInstructions (unBuilder b) emptySetting  -- | Document a setting -- -- Multiple 'help's concatenate help on new lines. help :: String -> Builder a-help s = Builder $ \op -> op {settingHelp = Just $ maybe s (s <>) (settingHelp op)}+help s = Builder [BuildAddHelp s]  -- | Document an 'option' or 'env' var. -- -- Multiple 'metavar's override eachother. metavar :: String -> Builder a-metavar mv = Builder $ \s -> s {settingMetavar = Just mv}+metavar mv = Builder [BuildSetMetavar mv]  -- | Try to parse an argument. --@@ -187,7 +223,7 @@ -- -- Multiple 'argument's are redundant. argument :: Builder a-argument = Builder $ \s -> s {settingTryArgument = True}+argument = Builder [BuildTryArgument]  -- | Try to parse an argument. --@@ -196,7 +232,7 @@ -- -- Multiple 'option's are redundant. option :: Builder a-option = Builder $ \s -> s {settingTryOption = True}+option = Builder [BuildTryOption]  -- | Try to parse a switch, activate the given value when succesful --@@ -204,11 +240,11 @@ -- -- Multiple 'switch's override eachother. switch :: a -> Builder a-switch v = Builder $ \s -> s {settingSwitchValue = Just v}+switch v = Builder [BuildSetSwitchValue v]  -- | Declare how to parse an argument, option, or environment variable. reader :: Reader a -> Builder a-reader r = Builder $ \s -> s {settingReaders = r : settingReaders s}+reader r = Builder [BuildAddReader r]  -- | Try to parse this 'long' 'option' or 'switch'. --@@ -221,9 +257,7 @@ -- Multiple 'long's will be tried in order. -- Empty 'long's will be ignored. long :: String -> Builder a-long l = Builder $ \s -> case NE.nonEmpty l of-  Nothing -> s-  Just ne -> s {settingDasheds = DashedLong ne : settingDasheds s}+long l = Builder [BuildAddLong ne | ne <- maybeToList (NE.nonEmpty l)]  -- | Try to parse this 'short' 'option' or 'switch'. --@@ -234,7 +268,7 @@ -- -- Multiple 'short's will be tried in order. short :: Char -> Builder a-short c = Builder $ \s -> s {settingDasheds = DashedShort c : settingDasheds s}+short c = Builder [BuildAddShort c]  -- | Try to parse an environment variable. --@@ -242,7 +276,7 @@ -- -- Multiple 'env's will be tried in order. env :: String -> Builder a-env v = Builder $ \s -> s {settingEnvVars = Just $ maybe (v :| []) (v <|) $ settingEnvVars s}+env v = Builder [BuildAddEnv v]  -- | Try to parse a configuration value at the given key. --@@ -250,6 +284,16 @@ conf :: (HasCodec a) => String -> Builder a conf k = confWith k codec +-- | Like 'conf' but with a custom 'Codec' for parsing the value.+confWith :: String -> ValueCodec void a -> Builder a+confWith k c = confWith' k (maybeCodec c)++-- | Like 'confWith' but allows interpreting 'Null' as a value other than "Not found".+confWith' :: String -> ValueCodec void (Maybe a) -> Builder a+confWith' k c =+  let t = ConfigValSetting {configValSettingPath = k :| [], configValSettingCodec = c}+   in Builder [BuildAddConf t]+ -- | Short-hand function for 'option', 'long', 'env', and 'conf' at the same time. -- -- Multiple 'name's will be tried in order.@@ -262,16 +306,6 @@       conf (toConfigCase s)     ] --- | Like 'conf' but with a custom 'Codec' for parsing the value.-confWith :: String -> ValueCodec void a -> Builder a-confWith k c = confWith' k (maybeCodec c)---- | Like 'confWith' but allows interpreting 'Null' as a value other than "Not found".-confWith' :: String -> ValueCodec void (Maybe a) -> Builder a-confWith' k c =-  let t = ConfigValSetting {configValSettingPath = k :| [], configValSettingCodec = c}-   in Builder $ \s -> s {settingConfigVals = Just $ maybe (t :| []) (t <|) $ settingConfigVals s}- -- | Set the default value -- -- Multiple 'value's override eachother.@@ -283,7 +317,7 @@  -- | Set the default value, along with a shown version of it. valueWithShown :: a -> String -> Builder a-valueWithShown a shown = Builder $ \s -> s {settingDefaultValue = Just (a, shown)}+valueWithShown a shown = Builder [BuildSetDefault a shown]  -- | Provide an example value for documentation. --@@ -291,7 +325,7 @@ -- -- If you use 'reader' 'auto', you'll want to use 'shownExample' instead. example :: String -> Builder a-example s = Builder $ \set -> set {settingExamples = s : settingExamples set}+example s = Builder [BuildAddExample s]  -- | Use 'Show' to show an 'example'. --@@ -303,4 +337,4 @@ -- -- Multiple 'hidden's are redundant. hidden :: Builder a-hidden = Builder $ \s -> s {settingHidden = True}+hidden = Builder [BuildSetHidden]