diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Changelog +## [0.4.0.3] - 2024-07-28 + +### Changed + +* Support (commands [..] <|> commands [..]) by concat-ing the lists of commands. +* Improved the documentation of parsers that use `some`. + ## [0.4.0.2] - 2024-07-27 ### Changed diff --git a/opt-env-conf.cabal b/opt-env-conf.cabal --- a/opt-env-conf.cabal +++ b/opt-env-conf.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: opt-env-conf -version: 0.4.0.2 +version: 0.4.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 diff --git a/src/OptEnvConf/Completion.hs b/src/OptEnvConf/Completion.hs --- a/src/OptEnvConf/Completion.hs +++ b/src/OptEnvConf/Completion.hs @@ -197,6 +197,11 @@ case mR of Nothing -> pure Nothing Just os -> fmap (os ++) <$> go p + ParserSome p -> do + mR <- go p + case mR of + Nothing -> pure Nothing + Just os -> fmap (os ++) <$> go p ParserAllOrNothing _ p -> go p ParserCheck _ _ _ p -> go p ParserCommands _ cs -> do diff --git a/src/OptEnvConf/Doc.hs b/src/OptEnvConf/Doc.hs --- a/src/OptEnvConf/Doc.hs +++ b/src/OptEnvConf/Doc.hs @@ -159,6 +159,7 @@ 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? ParserAllOrNothing _ p -> go p ParserCheck _ _ _ p -> go p ParserCommands _ cs -> AnyDocsCommands $ map commandParserDocs cs diff --git a/src/OptEnvConf/Error.hs b/src/OptEnvConf/Error.hs --- a/src/OptEnvConf/Error.hs +++ b/src/OptEnvConf/Error.hs @@ -16,6 +16,7 @@ { parseErrorSrcLoc :: !(Maybe SrcLoc), parseErrorMessage :: !ParseErrorMessage } + deriving (Show) data ParseErrorMessage = ParseErrorEmpty diff --git a/src/OptEnvConf/Lint.hs b/src/OptEnvConf/Lint.hs --- a/src/OptEnvConf/Lint.hs +++ b/src/OptEnvConf/Lint.hs @@ -199,6 +199,8 @@ ] LintErrorManyInfinite -> [ [ functionChunk "many", + " or ", + functionChunk "some", " was called with a parser that may succeed without consuming anything." ], ["This is not allowed because the parser would run infinitely."] @@ -237,6 +239,12 @@ pure (c1 && c2) -- TODO: is this right? -- TODO lint if we don't try to parse anything consuming under many. ParserMany p -> do + c <- go p + when (not c) $ + mapValidationTFailure (LintError Nothing) $ + validationTFailure LintErrorManyInfinite + pure c + ParserSome p -> do c <- go p when (not c) $ mapValidationTFailure (LintError Nothing) $ diff --git a/src/OptEnvConf/Nix.hs b/src/OptEnvConf/Nix.hs --- a/src/OptEnvConf/Nix.hs +++ b/src/OptEnvConf/Nix.hs @@ -37,6 +37,7 @@ ParserEmpty _ -> M.empty ParserAlt p1 p2 -> M.unionWith combineOption (go p1) (go p2) -- TODO is this right? ParserMany p -> go p + ParserSome p -> go p ParserAllOrNothing _ p -> go p ParserCheck _ _ _ p -> go p ParserCommands _ cs -> M.unionsWith combineOption $ map goCommand cs diff --git a/src/OptEnvConf/Parser.hs b/src/OptEnvConf/Parser.hs --- a/src/OptEnvConf/Parser.hs +++ b/src/OptEnvConf/Parser.hs @@ -169,6 +169,9 @@ ParserMany :: !(Parser a) -> Parser [a] + ParserSome :: + !(Parser a) -> + Parser (NonEmpty a) ParserAllOrNothing :: !(Maybe SrcLoc) -> !(Parser a) -> @@ -232,7 +235,8 @@ ParserSelect pe pf -> isEmpty pe && isEmpty pf ParserEmpty _ -> True ParserAlt _ _ -> False - ParserMany _ -> False + ParserMany p -> isEmpty p + ParserSome p -> isEmpty p ParserAllOrNothing _ p -> isEmpty p ParserCheck _ _ _ p -> isEmpty p ParserCommands _ cs -> null cs @@ -242,10 +246,30 @@ (True, True) -> ParserEmpty Nothing (True, False) -> p2 (False, True) -> p1 - (False, False) -> ParserAlt p1 p2 + (False, False) -> + let go p1' p2' = case (p1', p2') of + -- <|> needs to be associative, so we need to reorder the + -- alts to always be right-leaning + -- + -- That means if we want to construct this parser, where p1 and p3 are commands parsers: + -- p + -- / \ + -- p1 p2 + -- / \ + -- p3 p4 + -- + -- We need to rearrange it to + -- p + -- / \ + -- p1 ++ p3 p4 + (ParserCommands _ _, ParserAlt p3' p4') -> + go (go p1' p3') p4' + (ParserCommands mLoc1 cs1, ParserCommands mLoc2 cs2) -> + ParserCommands (mLoc1 <|> mLoc2) (cs1 ++ cs2) + _ -> ParserAlt p1' p2' + in go p1 p2 many = ParserMany - - some p = (:) <$> p <*> many p + some = fmap NE.toList . ParserSome showParserABit :: Parser a -> String showParserABit = ($ "") . showParserPrec 0 @@ -281,6 +305,10 @@ showParen (d > 10) $ showString "Many " . go 11 p + ParserSome p -> + showParen (d > 10) $ + showString "Some " + . go 11 p ParserAllOrNothing mLoc p -> showParen (d > 10) $ showString "AllOrNothing " @@ -466,7 +494,7 @@ -- | Like 'some' but with a more accurate type someNonEmpty :: Parser a -> Parser (NonEmpty a) -someNonEmpty p = (:|) <$> p <*> many p +someNonEmpty = ParserSome -- | Try a list of parsers in order choice :: (HasCallStack) => [Parser a] -> Parser a @@ -924,6 +952,7 @@ ParserEmpty _ -> ParserEmpty Nothing ParserAlt p1 p2 -> ParserAlt (go p1) (go p2) ParserMany p -> ParserMany (go p) + ParserSome p -> ParserSome (go p) ParserAllOrNothing _ p -> ParserAllOrNothing Nothing (go p) ParserCheck _ forgivable f p -> ParserCheck Nothing forgivable f (go p) ParserCommands _ cs -> ParserCommands Nothing $ map commandEraseSrcLocs cs @@ -960,6 +989,7 @@ ParserEmpty mLoc -> pure $ ParserEmpty mLoc ParserAlt p1 p2 -> ParserAlt <$> go p1 <*> go p2 ParserMany p -> ParserMany <$> go p + ParserSome p -> ParserSome <$> go p ParserAllOrNothing mLoc p -> ParserAllOrNothing mLoc <$> go p ParserCheck mLoc forgivable f p -> ParserCheck mLoc forgivable f <$> go p ParserCommands mLoc cs -> ParserCommands mLoc <$> traverse (commandTraverseSetting func) cs @@ -988,6 +1018,7 @@ ParserEmpty _ -> S.empty ParserAlt p1 p2 -> S.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 diff --git a/src/OptEnvConf/Run.hs b/src/OptEnvConf/Run.hs --- a/src/OptEnvConf/Run.hs +++ b/src/OptEnvConf/Run.hs @@ -407,6 +407,13 @@ Just a -> do as <- go (ParserMany p') pure (a : as) + ParserSome p' -> do + debug [syntaxChunk "Some"] + ppIndent $ do + a <- go p' + debug ["First element of some succeeded, continuing with Many"] + as <- go (ParserMany p') + pure (a :| as) ParserAllOrNothing mLoc p' -> do debug [syntaxChunk "AllOrNothing", ": ", mSrcLocChunk mLoc] ppIndent $ do @@ -773,6 +780,9 @@ ppIndent $ go p2 ParserMany p' -> do debug [syntaxChunk "Many"] + ppIndent $ go p' + ParserSome p' -> do + debug [syntaxChunk "Some"] ppIndent $ go p' ParserAllOrNothing mLoc p' -> do debug [syntaxChunk "AllOrNothing", ": ", mSrcLocChunk mLoc]