opt-env-conf 0.6.0.2 → 0.6.0.3

raw patch · 8 files changed

+85/−25 lines, 8 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• opt-env-conf.cabal +1/−1
• src/OptEnvConf.hs +2/−0
• src/OptEnvConf/Args.hs +11/−2
• src/OptEnvConf/Lint.hs +17/−7
• src/OptEnvConf/Output.hs +3/−0
• src/OptEnvConf/Parser.hs +35/−0
• src/OptEnvConf/Run.hs +4/−15

@@ -1,5 +1,17 @@ # Changelog +## [0.6.0.4] - 2024-10-24++### Added++* Added a lint for an unknown default command.++## [0.6.0.3] - 2024-10-24++### Added++* `withDefault` and `withShownDefault`.+ ## [0.6.0.2] - 2024-10-20  ### Changed

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           opt-env-conf-version:        0.6.0.2+version:        0.6.0.3 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

@@ -78,6 +78,8 @@     checkMapMaybe,     mapIO,     choice,+    withDefault,+    withShownDefault,      -- ** Loading configuration files     withConfig,

@@ -122,8 +122,17 @@ -- The result are all possible results consumeArgument :: Args -> [(Maybe String, Args)] consumeArgument as = do-  case argsAfter as of-    [] -> [(Nothing, as)]+  -- There's always the last-ditch option of consuming nothing in case of+  -- things like a default command.+  let addConsumeNothing = \case+        [] -> [(Nothing, as)]+        r@(t@(mA, _) : rest) -> case mA of+          -- If not consuming anything is already an option, don't add it to the end.+          Nothing -> r+          Just _ -> t : addConsumeNothing rest++  addConsumeNothing $ case argsAfter as of+    [] -> []     (firstArg : afters) ->       let befores = argsBefore as           consumed = Args (befores ++ [Dead]) afters

@@ -20,10 +20,10 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe-import Data.Text (Text) import qualified Data.Text as T import GHC.Stack (SrcLoc, prettySrcLoc) import OptEnvConf.Args+import OptEnvConf.Output import OptEnvConf.Parser import qualified OptEnvConf.Reader as OptEnvConf import OptEnvConf.Setting@@ -50,6 +50,7 @@   | LintErrorNoReaderForEnvVar   | LintErrorNoMetavarForEnvVar   | LintErrorNoCommands+  | LintErrorUnknownDefaultCommand !String   | LintErrorUnreadableExample !String   | LintErrorConfigWithoutLoad   | LintErrorManyInfinite@@ -196,6 +197,12 @@               " was called with an empty list."             ]           ]+        LintErrorUnknownDefaultCommand c ->+          [ [ functionChunk "defaultCommand",+              " was called with an unknown command: ",+              commandChunk c+            ]+          ]         LintErrorUnreadableExample e ->           [ [functionChunk "example", " was called with an example that none of the ", functionChunk "reader", "s succeed in reading."],             ["Example: ", chunk $ T.pack e]@@ -224,9 +231,6 @@       maybe [] (pure . ("Defined at: " :) . pure . fore cyan . chunk . T.pack . prettySrcLoc) lintErrorSrcLoc     ] -functionChunk :: Text -> Chunk-functionChunk = fore yellow . chunk- lintParser :: Parser a -> Maybe (NonEmpty LintError) lintParser =   either Just (const Nothing)@@ -268,10 +272,16 @@         pure c       ParserAllOrNothing _ p -> go p       ParserCheck _ _ _ p -> go p-      ParserCommands mLoc _ ls -> do-        if null ls+      ParserCommands mLoc mDefault cs -> do+        if null cs           then validationTFailure $ LintError mLoc LintErrorNoCommands-          else and <$> traverse (go . commandParser) ls -- TODO is this right?+          else do+            for_ mDefault $ \d ->+              when (isNothing (find ((== d) . commandArg) cs)) $+                validationTFailure $+                  LintError mLoc $+                    LintErrorUnknownDefaultCommand d+            and <$> traverse (go . commandParser) cs -- TODO is this right?       ParserWithConfig _ p1 p2 -> do         c1 <- go p1         c2 <- local (const True) (go p2)

@@ -32,6 +32,9 @@ commandChunk :: String -> Chunk commandChunk = fore magenta . chunk . T.pack +functionChunk :: Text -> Chunk+functionChunk = fore yellow . chunk+ mMetavarChunk :: Maybe Metavar -> Chunk mMetavarChunk = metavarChunk . fromMaybe "METAVAR" 

@@ -37,6 +37,8 @@     subAll,     subSettings,     someNonEmpty,+    withDefault,+    withShownDefault,     withConfig,     withYamlConfig,     withFirstYamlConfig,@@ -507,6 +509,39 @@ -- | Like 'some' but with a more accurate type someNonEmpty :: Parser a -> Parser (NonEmpty a) someNonEmpty = ParserSome++-- | Give a parser a default value.+--+-- This is morally equal to @(<|> pure a)@ but will give+-- you better documentation of the default value in many+-- cases.+--+-- This does nothing if the parser already has a default value.+withDefault :: (Show a) => a -> Parser a -> Parser a+withDefault defaultValue = withShownDefault defaultValue (show defaultValue)++-- | Like 'withDefault' but lets you specfiy how to show the default value+-- yourself.+withShownDefault :: a -> String -> Parser a -> Parser a+withShownDefault defaultValue shownDefault = go+  where+    go p =+      let p' = p <|> pure defaultValue+       in case p of+            ParserPure a -> ParserPure a+            ParserAp {} -> p'+            ParserSelect {} -> p'+            ParserEmpty _ -> ParserPure defaultValue+            ParserAlt p1 p2 -> ParserAlt p1 (go p2)+            ParserMany {} -> p'+            ParserSome {} -> p'+            ParserAllOrNothing {} -> p'+            ParserCheck {} -> p'+            ParserCommands {} -> p'+            ParserWithConfig {} -> p'+            ParserSetting mLoc s -> case settingDefaultValue s of+              Nothing -> ParserSetting mLoc $ s {settingDefaultValue = Just (defaultValue, shownDefault)}+              Just _ -> p  -- | Try a list of parsers in order choice :: (HasCallStack) => [Parser a] -> Parser a

@@ -453,15 +453,14 @@         debug [syntaxChunk "Commands", ": ", mSrcLocChunk mLoc]         forM_ mDefault $ \d -> debug ["default:", chunk $ T.pack $ show d]         ppIndent $ do-          stateBefore <- get           mS <- ppArg           let docsForErrors = map (void . commandParserDocs) cs-          let mDefaultCommand = do-                d <- mDefault-                find ((== d) . commandArg) cs           case mS of             Nothing -> do               debug ["No argument found for choosing a command."]+              let mDefaultCommand = do+                    d <- mDefault+                    find ((== d) . commandArg) cs               case mDefaultCommand of                 Nothing -> ppError mLoc $ ParseErrorMissingCommand docsForErrors                 Just dc -> do@@ -469,17 +468,7 @@                   go $ commandParser dc             Just s -> do               case find ((== s) . commandArg) cs of-                Nothing -> do-                  debug ["Argument found, but no matching command: ", chunk $ T.pack $ show s]-                  case mDefaultCommand of-                    Nothing -> ppError mLoc $ ParseErrorUnrecognisedCommand s docsForErrors-                    Just dc -> do-                      debug ["Choosing default command instead: ", commandChunk (commandArg dc)]-                      -- Put the state back to before we parsed 'ppArg' above-                      -- Maintainer note: We could try to un-parse this arg-                      -- somehow but that sounds more complicated to me.-                      put stateBefore-                      go $ commandParser dc+                Nothing -> ppError mLoc $ ParseErrorUnrecognisedCommand s docsForErrors                 Just c -> do                   debug ["Set command to ", commandChunk (commandArg c)]                   go $ commandParser c