From bc5b11e8d51975b1ad7d450b0b5040441afaef5b Mon Sep 17 00:00:00 2001 From: Joe Doyle Date: Mon, 27 Sep 2021 10:38:10 -0700 Subject: [PATCH] Make usage-/help-string behavior consistent with original `docopt` Fixes https://github.com/docopt/docopt.hs/issues/32. This makes 3 main changes to this library's behavior: 1) `pUsagePatterns` (and thus `pDocopt`) parses out the "Usage:" section of the helpstring as a string and returns that. The way I'm parsing it feels really hacky but I wasn't sure a better way to achieve it. 2) `exitWithUsage` and `exitWithUsaegMessage` now print that "short usage string" rather than the whole helpstring. `exitWithHelpstring` has been added, which prints the whole helpstring. 3) `parseArgsOrExit` automatically exits printing the helpstring if `longOption "help"` is present, to be more consistent with the original `docopt` behavior. I'm not sure this is the correct place in the library to put it, but it creates the intended behavior. --- System/Console/Docopt/NoTH.hs | 2 +- System/Console/Docopt/Public.hs | 15 ++++++++++++++- System/Console/Docopt/QQ.hs | 6 +++--- System/Console/Docopt/Types.hs | 4 +++- System/Console/Docopt/UsageParse.hs | 15 +++++++++------ examples/NavalFate/Shared.hs | 2 -- test/LangAgnosticTests.hs | 2 +- 7 files changed, 31 insertions(+), 15 deletions(-) diff --git a/System/Console/Docopt/NoTH.hs b/System/Console/Docopt/NoTH.hs index 15adb0d..d1ed517 100644 --- a/System/Console/Docopt/NoTH.hs +++ b/System/Console/Docopt/NoTH.hs @@ -26,7 +26,7 @@ parseUsage rawUsg = let usg = trimEmptyLines rawUsg in case runParser pDocopt M.empty "Usage" usg of Left e -> Left e - Right optfmt -> Right (Docopt optfmt usg) + Right (short_usg,optfmt) -> Right (Docopt optfmt short_usg usg) -- | Same as 'parseUsage', but 'exitWithUsage' on parse failure. E.g. -- diff --git a/System/Console/Docopt/Public.hs b/System/Console/Docopt/Public.hs index cf6d059..a680453 100644 --- a/System/Console/Docopt/Public.hs +++ b/System/Console/Docopt/Public.hs @@ -10,6 +10,7 @@ module System.Console.Docopt.Public -- * Parsed usage string , Docopt () , usage + , exitWithHelpstring , exitWithUsage , exitWithUsageMessage @@ -47,6 +48,7 @@ import Data.Maybe (fromMaybe) import System.Console.Docopt.Types import System.Console.Docopt.ApplicativeParsec (ParseError) import System.Console.Docopt.OptParse +import Control.Monad (when) -- | Parse command line arguments. @@ -57,11 +59,22 @@ parseArgs parser = getArguments (optFormat parser) -- -- > args <- parseArgsOrExit patterns =<< getArgs parseArgsOrExit :: Docopt -> [String] -> IO Arguments -parseArgsOrExit parser argv = either (const $ exitWithUsage parser) return $ parseArgs parser argv +parseArgsOrExit parser argv = do + opts <- either (const $ exitWithUsage parser) return $ parseArgs parser argv + when (opts `isPresent` (longOption "help")) $ do + exitWithHelpstring parser + return opts + -- | Exit after printing usage text. exitWithUsage :: Docopt -> IO a exitWithUsage doc = do + putStr $ shortUsage doc + exitFailure + +-- | Exit after printing the helpstring. +exitWithHelpstring :: Docopt -> IO a +exitWithHelpstring doc = do putStr $ usage doc exitFailure diff --git a/System/Console/Docopt/QQ.hs b/System/Console/Docopt/QQ.hs index a468231..3094a72 100644 --- a/System/Console/Docopt/QQ.hs +++ b/System/Console/Docopt/QQ.hs @@ -17,15 +17,15 @@ import System.Console.Docopt.UsageParse import Language.Haskell.TH import Language.Haskell.TH.Quote -parseFmt :: FilePath -> String -> Either ParseError OptFormat +parseFmt :: FilePath -> String -> Either ParseError (String,OptFormat) parseFmt = runParser pDocopt M.empty docoptExp :: String -> Q Exp docoptExp rawUsg = do let usg = trimEmptyLines rawUsg - let mkDocopt fmt = Docopt { usage = usg, optFormat = fmt } + let mkDocopt short_usg fmt = Docopt { usage = usg, shortUsage = short_usg, optFormat = fmt } loc <- loc_filename <$> location - case mkDocopt <$> parseFmt loc usg of + case uncurry mkDocopt <$> parseFmt loc usg of Left err -> fail $ show err Right parser -> [| parser |] diff --git a/System/Console/Docopt/Types.hs b/System/Console/Docopt/Types.hs index cfc697e..96d26bb 100644 --- a/System/Console/Docopt/Types.hs +++ b/System/Console/Docopt/Types.hs @@ -103,6 +103,8 @@ type Arguments = Map Option ArgValue -- | An abstract data type which represents Docopt usage patterns. data Docopt = Docopt { optFormat :: OptFormat + -- | Retrieve the "Usage:" section of the usage string. + , shortUsage :: String -- | Retrieve the original usage string. , usage :: String - } + } deriving(Show) diff --git a/System/Console/Docopt/UsageParse.hs b/System/Console/Docopt/UsageParse.hs index 9d00d17..1b5970d 100644 --- a/System/Console/Docopt/UsageParse.hs +++ b/System/Console/Docopt/UsageParse.hs @@ -145,13 +145,16 @@ pUsageLine = many1 (satisfy (not . isSpace)) -- prog name pLine -pUsagePatterns :: CharParser OptInfoMap OptPattern +pUsagePatterns :: CharParser OptInfoMap (String,OptPattern) pUsagePatterns = do many (notFollowedBy pUsageHeader >> anyChar) - pUsageHeader + header <- pUsageHeader optionalEndline + usageLines_str <- fmap (unlines . (header:)) . lookAhead $ many $ try $ do + lookAhead $ pUsageLine + manyTill anyChar $ try $ eof <|> (const () <$> endline) usageLines <- pUsageLine `sepEndBy` endline - return $ flatten . OneOf $ usageLines + return $ (usageLines_str, flatten . OneOf $ usageLines) -- * Option Synonyms & Defaults Parsers @@ -204,16 +207,16 @@ pOptDescriptions = do -- | Main usage parser: parses all of the usage lines into an Exception, -- and all of the option descriptions along with any accompanying -- defaults, and returns both in a tuple -pDocopt :: CharParser OptInfoMap OptFormat +pDocopt :: CharParser OptInfoMap (String,OptFormat) pDocopt = do - optPattern <- pUsagePatterns + (usage_str,optPattern) <- pUsagePatterns optInfoMap <- pOptDescriptions let optPattern' = eagerSort $ expectSynonyms optInfoMap optPattern saveCanRepeat pat el minfo = case minfo of (Just info) -> Just $ info {isRepeated = canRepeat pat el} (Nothing) -> Just $ (fromSynList []) {isRepeated = canRepeat pat el} optInfoMap' = alterAllWithKey (saveCanRepeat optPattern') (atoms optPattern') optInfoMap - return (optPattern', optInfoMap') + return (usage_str,(optPattern', optInfoMap')) -- ** Pattern transformation & analysis diff --git a/examples/NavalFate/Shared.hs b/examples/NavalFate/Shared.hs index 201f016..5bca6a4 100644 --- a/examples/NavalFate/Shared.hs +++ b/examples/NavalFate/Shared.hs @@ -55,5 +55,3 @@ navalFateDispatchArgs doc opts = do exitSuccess when (opts `isPresent` (longOption "version")) $ do putStrLn "Naval Fate v0.0.0.0.0.1.0" - when (opts `isPresent` (longOption "help")) $ do - exitWithUsage doc diff --git a/test/LangAgnosticTests.hs b/test/LangAgnosticTests.hs index 48fba33..451375a 100644 --- a/test/LangAgnosticTests.hs +++ b/test/LangAgnosticTests.hs @@ -116,7 +116,7 @@ testsFromDocoptSpecFile name testFile ignore = let (optFormat, docParseMsg) = case runParser pDocopt M.empty "Usage" usage of Left e -> ((Sequence [], M.empty), "Couldn't parse usage text") - Right o -> (o, "") + Right (_,o) -> (o, "") let groupDescLines = [ docParseMsg,