opt-env-conf 0.6.0.3 → 0.7.0.1

raw patch · 7 files changed

+80/−45 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• opt-env-conf.cabal +1/−1
• src/OptEnvConf/Doc.hs +3/−0
• src/OptEnvConf/Error.hs +9/−4
• src/OptEnvConf/Parser.hs +15/−25
• src/OptEnvConf/Run.hs +14/−13
• src/OptEnvConf/Setting.hs +24/−1

@@ -1,6 +1,19 @@ # Changelog -## [0.6.0.4] - 2024-10-24+## [0.7.0.1] - 2024-10-27++### Changed++* Fixed a bug in which `allOrNothing` (and `subSettings`) could malfunction+  when using a common library setting multiple times.++## [0.7.0.0] - 2024-10-27++### Added++* The `allOrNothing` error now shows which settings were defined.++## [0.6.0.4] - 2024-10-26  ### Added 

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

@@ -14,11 +14,14 @@     renderManPage,     renderReferenceDocumentation,     parserOptDocs,+    docsToOptDocs,     renderLongOptDocs,     renderShortOptDocs,     parserEnvDocs,+    docsToEnvDocs,     renderEnvDocs,     parserConfDocs,+    docsToConfDocs,     renderConfDocs,      -- * Internal

@@ -6,10 +6,13 @@  import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE+import Data.Map (Map)+import qualified Data.Map as M import qualified Data.Text as T import GHC.Stack (SrcLoc) import OptEnvConf.Doc import OptEnvConf.Output+import OptEnvConf.Setting import Text.Colour  data ParseError = ParseError@@ -34,7 +37,7 @@   | ParseErrorConfigRead !(Maybe ConfDoc) !String   | ParseErrorMissingCommand ![CommandDoc ()]   | ParseErrorUnrecognisedCommand !String ![CommandDoc ()]-  | ParseErrorAllOrNothing+  | ParseErrorAllOrNothing !(Map SettingHash SrcLoc)   | ParseErrorUnrecognised !(NonEmpty String)   deriving (Show) @@ -59,7 +62,7 @@   ParseErrorConfigRead _ _ -> False   ParseErrorMissingCommand cs -> not $ null cs   ParseErrorUnrecognisedCommand _ _ -> False-  ParseErrorAllOrNothing -> False+  ParseErrorAllOrNothing _ -> False   ParseErrorUnrecognised _ -> False  eraseErrorSrcLocs :: (Functor f) => f ParseError -> f ParseError@@ -122,9 +125,11 @@             [fore blue "available commands:"]           ]             ++ availableCommandsLines cs-        ParseErrorAllOrNothing ->-          [ ["You are seeing this error because at least one, but not all, of the settings in an allOrNothing (or subSettings) parser have been defined."]+        ParseErrorAllOrNothing locs ->+          [ ["You are seeing this error because at least one, but not all, of the settings in an allOrNothing (or subSettings) parser have been defined."],+            ["The following settings have been parsed:"]           ]+            ++ map (pure . srcLocChunk) (M.elems locs)         ParseErrorUnrecognised leftovers ->           ["Unrecognised args: " : unwordsChunks (map (pure . chunk . T.pack) (NE.toList leftovers))],       maybe [] (pure . ("see " :) . pure . srcLocChunk) parseErrorSrcLoc

@@ -71,9 +71,7 @@     commandTraverseSetting,      -- ** All or nothing implementation-    parserSettingsSet,-    SrcLocHash (..),-    hashSrcLoc,+    parserSettingsMap,      -- ** Re-exports     Functor (..),@@ -90,17 +88,16 @@ import Data.Aeson as JSON import qualified Data.Aeson.KeyMap as KM import Data.Functor.Identity-import Data.Hashable import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE+import Data.Map (Map)+import qualified Data.Map as M import Data.Maybe-import Data.Set (Set)-import qualified Data.Set as S import Data.String import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T-import GHC.Stack (HasCallStack, SrcLoc, callStack, getCallStack, prettySrcLoc, withFrozenCallStack)+import GHC.Stack (HasCallStack, SrcLoc, callStack, getCallStack, withFrozenCallStack) import OptEnvConf.Args (Dashed (..), prefixDashed) import OptEnvConf.Casing import OptEnvConf.Reader@@ -1138,28 +1135,21 @@   (\p -> c {commandParser = p})     <$> parserTraverseSetting func (commandParser c) -parserSettingsSet :: Parser a -> Set SrcLocHash-parserSettingsSet = go+parserSettingsMap :: Parser a -> Map SettingHash SrcLoc+parserSettingsMap = go   where-    go :: Parser a -> Set SrcLocHash+    go :: Parser a -> Map SettingHash SrcLoc     go = \case-      ParserPure _ -> S.empty-      ParserAp p1 p2 -> S.union (go p1) (go p2)-      ParserSelect p1 p2 -> S.union (go p1) (go p2)-      ParserEmpty _ -> S.empty-      ParserAlt p1 p2 -> S.union (go p1) (go p2)+      ParserPure _ -> M.empty+      ParserAp p1 p2 -> M.union (go p1) (go p2)+      ParserSelect p1 p2 -> M.union (go p1) (go p2)+      ParserEmpty _ -> M.empty+      ParserAlt p1 p2 -> M.union (go p1) (go p2)       ParserMany p -> go p       ParserSome p -> go p       ParserAllOrNothing _ p -> go p -- TODO is this right?       ParserCheck _ _ _ p -> go p-      ParserCommands _ _ cs -> S.unions $ map (go . commandParser) cs-      ParserWithConfig _ p1 p2 -> S.union (go p1) (go p2)+      ParserCommands _ _ cs -> M.unions $ map (go . commandParser) cs+      ParserWithConfig _ p1 p2 -> M.union (go p1) (go p2)       -- The nothing part shouldn't happen but I don't know when it doesn't-      ParserSetting mLoc _ -> maybe S.empty (S.singleton . hashSrcLoc) mLoc---- An 'Ord'-able SrcLoc-newtype SrcLocHash = SrcLocHash Int-  deriving (Eq, Ord)--hashSrcLoc :: SrcLoc -> SrcLocHash-hashSrcLoc = SrcLocHash . hash . prettySrcLoc+      ParserSetting mLoc s -> maybe M.empty (M.singleton (hashSetting s)) mLoc

@@ -26,9 +26,9 @@ import Data.List (find) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE+import Data.Map (Map)+import qualified Data.Map as M import Data.Maybe-import Data.Set (Set)-import qualified Data.Set as S import qualified Data.Text as T import Data.Traversable import Data.Version@@ -325,7 +325,7 @@   let ppState =         PPState           { ppStateArgs = args,-            ppStateParsedSettings = S.empty+            ppStateParsedSettings = M.empty           }   let ppEnv =         PPEnv@@ -421,19 +421,19 @@                 then ppErrors' errs                 else do                   -- Settings available below-                  let settingsSet = parserSettingsSet p'+                  let settingsMap = parserSettingsMap p'                   -- Settings that have been parsed-                  parsedSet <- gets ppStateParsedSettings+                  parsedMap <- gets ppStateParsedSettings                   -- Settings that have been parsed below-                  let parsedSettingsSet = settingsSet `S.intersection` parsedSet+                  let parsedSettingsMap = settingsMap `M.intersection` parsedMap                   -- If any settings have been parsed below, and parsing still failed                   -- (this is the case because we're in the failure branch)                   -- with only forgivable errors                   -- (this is the case because we're in the branch where that's been checked)                   -- then this should be an unforgivable error.-                  if not (null parsedSettingsSet)-                    then ppErrors' $ errs <> (ParseError mLoc ParseErrorAllOrNothing :| [])-                    else ppErrors' errs+                  if null parsedSettingsMap+                    then ppErrors' errs+                    else ppErrors' $ errs <> (ParseError mLoc (ParseErrorAllOrNothing parsedSettingsMap) :| [])       ParserCheck mLoc forgivable f p' -> do         debug [syntaxChunk "Parser with check", ": ", mSrcLocChunk mLoc]         ppIndent $ do@@ -490,8 +490,9 @@                   ( \loc -> modify' $ \s ->                       s                         { ppStateParsedSettings =-                            S.insert-                              (hashSrcLoc loc)+                            M.insert+                              (hashSetting set)+                              loc                               (ppStateParsedSettings s)                         }                   )@@ -725,7 +726,7 @@   let ppState =         PPState           { ppStateArgs = args,-            ppStateParsedSettings = S.empty+            ppStateParsedSettings = M.empty           }   let ppEnv =         PPEnv@@ -866,7 +867,7 @@  data PPState = PPState   { ppStateArgs :: !Args,-    ppStateParsedSettings :: !(Set SrcLocHash)+    ppStateParsedSettings :: !(Map SettingHash SrcLoc)   }  data PPEnv = PPEnv

@@ -34,6 +34,8 @@      -- * Internal     showSettingABit,+    SettingHash (..),+    hashSetting,     completeBuilder,     mapMaybeBuilder,     emptySetting,@@ -45,10 +47,11 @@ where  import Autodocodec+import Data.Hashable import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import Data.Maybe-import OptEnvConf.Args (Dashed (..))+import OptEnvConf.Args (Dashed (..), renderDashed) import OptEnvConf.Casing import OptEnvConf.Reader import Text.Show@@ -88,6 +91,26 @@     settingMetavar :: !(Maybe Metavar),     settingHelp :: !(Maybe String)   }++-- An 'Ord'-able Setting without giving 'Setting' an 'Eq' instance+newtype SettingHash = SettingHash Int+  deriving (Show, Eq, Ord)++-- We hash only the parts of the setting that have anything to do with how the+-- setting is parsed, not the parts that are for documentation.+hashSetting :: Setting a -> SettingHash+hashSetting Setting {..} =+  SettingHash+    ( 42+        `hashWithSalt` map renderDashed settingDasheds+        `hashWithSalt` settingTryArgument+        `hashWithSalt` length settingReaders+        `hashWithSalt` isJust settingSwitchValue+        `hashWithSalt` settingTryOption+        `hashWithSalt` settingEnvVars+        `hashWithSalt` (NE.map configValSettingPath <$> settingConfigVals)+        `hashWithSalt` (snd <$> settingDefaultValue)+    )  data ConfigValSetting a = forall void.   ConfigValSetting