diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +### 0.7.0.5 + +- Fix an issue where in some cases pattern lines were matched out of order [#16] +- Strip leading & trailing newlines from usage, for quasiquoter ease [#28] +- Fix tests run against latest aeson 1.0.2.0 [#29] + ### 0.7.0.4 - Fix the test suite when run from a distributed tarball [#21] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -139,7 +139,7 @@ - #### `[-]` and `[--]` - Single hyphen `-` is used by convention to specify using `stdin` as input instead of reading a file. Double hyphen `--` is typically used to manually separate leading options from trailing positional arguments. Both of these are treated as `command`s, and so are perfectly legal in usage patterns. They are typically optional elements, but can be required if you drop the `[]`. + Single hyphen `-` is used by convention to specify using `stdin` as input instead of reading a file. Double hyphen `--` is typically used to manually separate leading options from trailing positional arguments. Both of these are treated as `command`s, and so are perfectly legal in usage patterns. They are typically optional elements, but can be required if you drop the `[]`. These are treated as commands and can be matched with `command "-"` or `command "--"`, whether they're wrapped `[-]` or not. Option descriptions ------------------- diff --git a/System/Console/Docopt/NoTH.hs b/System/Console/Docopt/NoTH.hs --- a/System/Console/Docopt/NoTH.hs +++ b/System/Console/Docopt/NoTH.hs @@ -14,7 +14,7 @@ import System.Console.Docopt.Types import System.Console.Docopt.Public import System.Console.Docopt.ParseUtils -import System.Console.Docopt.UsageParse (pDocopt) +import System.Console.Docopt.UsageParse (pDocopt, trimEmptyLines) -- | Parse docopt-formatted usage patterns. @@ -22,8 +22,9 @@ -- For help with the docopt usage format, see -- . parseUsage :: String -> Either ParseError Docopt -parseUsage usg = - case runParser pDocopt M.empty "Usage" usg of +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) @@ -32,7 +33,8 @@ -- > let usageStr = "Usage:\n prog [--option]\n" -- > patterns <- parseUsageOrExit usageStr parseUsageOrExit :: String -> IO Docopt -parseUsageOrExit usg = exitUnless $ parseUsage usg +parseUsageOrExit rawUsg = exitUnless $ parseUsage usg where + usg = trimEmptyLines rawUsg exit message = putStrLn message >> exitFailure exitUnless = either (const $ exit usg) return diff --git a/System/Console/Docopt/OptParse.hs b/System/Console/Docopt/OptParse.hs --- a/System/Console/Docopt/OptParse.hs +++ b/System/Console/Docopt/OptParse.hs @@ -217,7 +217,7 @@ delim = "«»" argvString = delim `intercalate` argv - p = parsedArgs <$> (returnState $ buildOptParser delim optfmt) + p = parsedArgs <$> returnState (buildOptParser delim optfmt) patAtoms = atoms pattern infoKeys = (\\ [AnyOption]) $ M.keys infomap @@ -229,6 +229,6 @@ e_parsedArgs = runParser p initialState "argv" argvString - fillMissingDefaults = \pargs -> M.union pargs defaultArgVals + fillMissingDefaults pargs = M.union pargs defaultArgVals in fillMissingDefaults <$> e_parsedArgs diff --git a/System/Console/Docopt/Public.hs b/System/Console/Docopt/Public.hs --- a/System/Console/Docopt/Public.hs +++ b/System/Console/Docopt/Public.hs @@ -151,6 +151,8 @@ ---------------------- -- | For @Usage: prog cmd@, ask for @command \"cmd\"@. +-- +-- For @Usage: prog -@ or @Usage: prog [-]@, ask for @command \"-\"@. Same for @--@. command :: String -> Option command = Command diff --git a/System/Console/Docopt/QQ.hs b/System/Console/Docopt/QQ.hs --- a/System/Console/Docopt/QQ.hs +++ b/System/Console/Docopt/QQ.hs @@ -21,7 +21,8 @@ parseFmt = runParser pDocopt M.empty docoptExp :: String -> Q Exp -docoptExp usg = do +docoptExp rawUsg = do + let usg = trimEmptyLines rawUsg let mkDocopt fmt = Docopt { usage = usg, optFormat = fmt } loc <- loc_filename <$> location case mkDocopt <$> parseFmt loc usg of diff --git a/System/Console/Docopt/Types.hs b/System/Console/Docopt/Types.hs --- a/System/Console/Docopt/Types.hs +++ b/System/Console/Docopt/Types.hs @@ -1,9 +1,10 @@ module System.Console.Docopt.Types where +import Data.Char (isUpper) +import Data.List (nub) import Data.Map (Map) import qualified Data.Map as M -import Data.List (nub) -- * Usage expression Types @@ -39,7 +40,9 @@ humanize :: Option -> String humanize opt = case opt of Command name -> name - Argument name -> name + Argument name -> if all isUpper name + then name + else "<" ++ name ++ ">" LongOption name -> "--"++name ShortOption c -> ['-',c] AnyOption -> "[options]" diff --git a/System/Console/Docopt/UsageParse.hs b/System/Console/Docopt/UsageParse.hs --- a/System/Console/Docopt/UsageParse.hs +++ b/System/Console/Docopt/UsageParse.hs @@ -4,7 +4,7 @@ import qualified Data.Map as M import Data.Ord (comparing) import GHC.Exts (Down(..)) -import Data.List (nub, sortBy, maximumBy) +import Data.List (nub, sortBy, maximumBy, dropWhile, dropWhileEnd) import System.Console.Docopt.ParseUtils import System.Console.Docopt.Types @@ -25,7 +25,13 @@ flatOneOf :: [Pattern a] -> Pattern a flatOneOf = flatten . OneOf +trimEmptyLines :: String -> String +trimEmptyLines s = trimmed s ++ "\n" + where + isNewline = (== '\n') + trimmed = dropWhile isNewline . dropWhileEnd isNewline + -- * Pattern Parsers pLine :: CharParser OptInfoMap OptPattern @@ -280,18 +286,25 @@ -- | Sort an OptPattern such that more-specific patterns come first, -- while leaving the semantics of the pattern structure unchanged. eagerSort :: OptPattern -> OptPattern -eagerSort pat = - case pat of - Sequence ps -> Sequence $ map eagerSort ps - OneOf ps -> OneOf $ map eagerSort - . sortBy (comparing $ Down . maxLength) - . sortBy (comparing representativeAtom) - $ ps - Unordered ps -> Unordered $ map eagerSort ps - Optional p -> Optional $ eagerSort p - Repeated p -> Repeated $ eagerSort p - a@(Atom _) -> a +eagerSort pat = case pat of + -- We special-case a top-level `OneOf` here because that's how + -- the list of individual pattern lines are represented, and we + -- never want to reorder those. This is inelegant, but effective + -- enough for now. + OneOf ps -> OneOf $ map innerSort ps + a -> innerSort a where + innerSort ipat = case ipat of + Sequence ps -> Sequence $ map innerSort ps + OneOf ps -> OneOf $ map innerSort + . sortBy (comparing $ Down . maxLength) + . sortBy (comparing representativeAtom) + $ ps + Unordered ps -> Unordered $ map innerSort ps + Optional p -> Optional $ innerSort p + Repeated p -> Repeated $ innerSort p + a@(Atom _) -> a + representativeAtom :: OptPattern -> Option representativeAtom p = case p of Sequence ps -> if null ps then AnyOption else representativeAtom $ head ps @@ -300,6 +313,7 @@ Optional p -> representativeAtom p Repeated p -> representativeAtom p Atom a -> a + maxLength :: OptPattern -> Int maxLength p = case p of Sequence ps -> sum $ map maxLength ps @@ -311,5 +325,5 @@ LongOption o -> length o ShortOption _ -> 1 Command c -> length c - Argument a -> length a + Argument a -> 100 AnyOption -> 0 diff --git a/docopt.cabal b/docopt.cabal --- a/docopt.cabal +++ b/docopt.cabal @@ -1,5 +1,5 @@ name: docopt -version: 0.7.0.4 +version: 0.7.0.5 synopsis: A command-line interface parser that will make you smile description: Docopt parses command-line interface usage text that adheres to a familiar syntax, and from it builds a command-line argument parser that will ensure your program is invoked correctly with the available options specified in the usage text. This allows the developer to write a usage text and get an argument parser for free. @@ -21,6 +21,7 @@ CHANGELOG.md data-files: test/testcases.docopt + test/regressions.txt source-repository head type: git @@ -42,8 +43,8 @@ System.Console.Docopt.OptParse System.Console.Docopt.Public - build-depends: base == 4.*, - parsec == 3.1.*, + build-depends: base >= 4.0 && < 5.0, + parsec >= 3.1.0, containers ghc-options: -Wall @@ -56,8 +57,8 @@ exposed-modules: System.Console.Docopt other-modules: System.Console.Docopt.QQ System.Console.Docopt.QQ.Instances - build-depends: template-haskell >= 2.7 && < 3.0, - th-lift >= 0.7 && < 1.0 + build-depends: template-haskell, + th-lift test-suite tests type: exitcode-stdio-1.0 @@ -71,22 +72,26 @@ -fno-warn-name-shadowing -fno-warn-orphans - build-depends: base == 4.*, - parsec == 3.1.*, + build-depends: base, + parsec, containers, docopt, HUnit, - split >= 0.2.2, - ansi-terminal >= 0.6, - aeson >= 0.8, - bytestring == 0.10.*, + split, + ansi-terminal, + aeson, + bytestring, + text, template-haskell, th-lift - other-modules: System.Console.Docopt.ApplicativeParsec, - System.Console.Docopt.ParseUtils, - System.Console.Docopt.Types, - System.Console.Docopt.UsageParse, - System.Console.Docopt.OptParse, - System.Console.Docopt.Public, + other-modules: System.Console.Docopt + System.Console.Docopt.ApplicativeParsec + System.Console.Docopt.ParseUtils + System.Console.Docopt.Types + System.Console.Docopt.UsageParse + System.Console.Docopt.OptParse + System.Console.Docopt.Public + System.Console.Docopt.QQ + System.Console.Docopt.QQ.Instances Paths_docopt diff --git a/test/LangAgnosticTests.hs b/test/LangAgnosticTests.hs --- a/test/LangAgnosticTests.hs +++ b/test/LangAgnosticTests.hs @@ -30,7 +30,7 @@ Present -> toJSON True NotPresent -> toJSON False -instance ToJSON (Map Option ArgValue) where +instance {-# OVERLAPPING #-} ToJSON (Map Option ArgValue) where toJSON argmap = let argmap' = M.mapKeys humanize argmap in toJSON argmap' @@ -50,64 +50,55 @@ main :: IO () main = do - f <- (getDataFileName >=> readFile) "test/testcases.docopt" - tests <- testsFromDocoptSpecFile "testcases.docopt" f blacklist - counts <- runTestTT $ TestList tests + referenceTestsFile <- (getDataFileName >=> readFile) "test/testcases.docopt" + referenceTests <- testsFromDocoptSpecFile "testcases.docopt" referenceTestsFile testcasesBlacklist + + regressionTestsFile <- (getDataFileName >=> readFile) "test/regressions.txt" + regressionTests <- testsFromDocoptSpecFile "regressions.txt" regressionTestsFile regressionsBlacklist + + counts <- runTestTT $ TestList $ referenceTests ++ regressionTests exitWith $ if failures counts > 0 then ExitFailure 1 else ExitSuccess -blacklist :: (Int, Int) -> Bool + +testcasesBlacklist :: (Int, Int) -> Bool -- Short/long option synonym equality (will fix) -blacklist (4, 1) = True -blacklist (4, 3) = True -blacklist (7, 1) = True -blacklist (8, 1) = True -blacklist (8, 2) = True -blacklist (64, 1) = True +testcasesBlacklist (4, 1) = True +testcasesBlacklist (4, 3) = True +testcasesBlacklist (7, 1) = True +testcasesBlacklist (8, 1) = True +testcasesBlacklist (8, 2) = True +testcasesBlacklist (35, 1) = True +testcasesBlacklist (64, 1) = True -- Partial-option disambiguation -blacklist (4, 2) = True -blacklist (6, 3) = True -blacklist (6, 4) = True -blacklist (12, 4) = True +testcasesBlacklist (4, 2) = True +testcasesBlacklist (6, 3) = True +testcasesBlacklist (6, 4) = True +testcasesBlacklist (12, 4) = True -- Stacked short options/flags disambiguation -blacklist (14, 1) = True -blacklist (70, 1) = True +testcasesBlacklist (14, 1) = True +testcasesBlacklist (70, 1) = True -- Option order insensitivity -blacklist (15, 2) = True -blacklist (16, 2) = True -blacklist (17, 2) = True -blacklist (18, 2) = True --- Argument lookup key ("" v. "arg"; should fix) -blacklist (21, 1) = True -blacklist (22, 1) = True -blacklist (22, 3) = True -blacklist (23, 1) = True -blacklist (24, 1) = True -blacklist (24, 2) = True -blacklist (25, 2) = True -blacklist (25, 3) = True -blacklist (26, 1) = True -blacklist (26, 2) = True -blacklist (27, 1) = True -blacklist (27, 2) = True -blacklist (27, 3) = True -blacklist (28, 1) = True -blacklist (28, 3) = True -blacklist (35, 1) = True -blacklist (60, 1) = True -blacklist (60, 2) = True -blacklist (61, 1) = True -blacklist (66, 1) = True -blacklist (72, 1) = True +testcasesBlacklist (15, 2) = True +testcasesBlacklist (16, 2) = True +testcasesBlacklist (17, 2) = True +testcasesBlacklist (18, 2) = True -- Weirdly broken (argument capture; should fix) -blacklist (33, 2) = True -blacklist (33, 3) = True -blacklist (34, 3) = True +testcasesBlacklist (33, 2) = True +testcasesBlacklist (33, 3) = True +testcasesBlacklist (34, 3) = True -- [options] expansion pruning (should fix) -blacklist (67, 1) = True -blacklist _ = False +testcasesBlacklist (67, 1) = True +testcasesBlacklist _ = False +regressionsBlacklist :: (Int, Int) -> Bool +-- Failing tests for issue #25, should investigate & fix +regressionsBlacklist (6, 1) = True +regressionsBlacklist (6, 2) = True +regressionsBlacklist _ = False + + testsFromDocoptSpecFile :: String -> String -> ((Int, Int) -> Bool) @@ -150,7 +141,7 @@ testCaseEquality = if rawTarget == "\"user-error\"" then M.null parsedArgs else maybeTargetJSON == Just parsedArgsJSON - blacklisted = blacklist (icg, itc) + blacklisted = ignore (icg, itc) testCaseSuccess = if blacklisted then not testCaseEquality else testCaseEquality diff --git a/test/regressions.txt b/test/regressions.txt new file mode 100644 --- /dev/null +++ b/test/regressions.txt @@ -0,0 +1,71 @@ +r"""Usage: + prog + prog --help + +""" +$ prog --help +{"":"--help", "--help":false} + + +# Issue #16: Top-level patterns should never get reordered. +r"""Usage: + prog + prog --help + +""" +$ prog --help +{"":"--help", "--help":false} + + +# Issue #25: Repeatable options should be counted +r"""Usage: + prog (-v | -vv) + +""" +$ prog -v +{"-v": 1} + +$ prog -vv +{"-v": 2} + + +# Issue #25: Repeatable options should be counted +r"""Usage: + prog [--verbose]... + +Options: + --verbose, -v verbosity +""" +$ prog --verbose +{"--verbose": 1, "-v": 1} + +$ prog -vv +{"--verbose": 2, "-v": 2} + + +# Issue #25: Repeatable options with values should be collected +r"""Usage: + prog [--include]... + +Options: + --include=, -I stuff to include +""" +$ prog -I foo +{"--include": ["foo"], "-I": ["foo"]} + +$ prog -I foo -I bar +{"--include": ["foo","bar"], "-I": ["foo","bar"]} + + +# Issue #25: Repeatable options with values should be collected +r"""Usage: + prog [options]... + +Options: + --include=, -I stuff to include +""" +$ prog -I foo +{"--include": ["foo"], "-I": ["foo"]} + +$ prog -I foo -I bar +{"--include": ["foo","bar"], "-I": ["foo","bar"]}