docopt 0.7.0.3 → 0.7.0.4
raw patch · 8 files changed
+1151/−115 lines, 8 filesdep +HUnitdep ~aesondep ~ansi-terminaldep ~splitPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit
Dependency ranges changed: aeson, ansi-terminal, split
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−1
- System/Console/Docopt/ApplicativeParsec.hs +0/−1
- System/Console/Docopt/ParseUtils.hs +15/−10
- System/Console/Docopt/Types.hs +3/−5
- System/Console/Docopt/UsageParse.hs +50/−50
- docopt.cabal +24/−7
- test/LangAgnosticTests.hs +123/−41
- test/testcases.docopt +930/−0
CHANGELOG.md view
@@ -1,7 +1,12 @@+### 0.7.0.4++- Fix the test suite when run from a distributed tarball [#21]+- Make the test suite more developer-friendly+ ### 0.7.0.3 - Fix `isPresent` treatment of repeatable arguments/options [#15]-- Fix build failure for stackage inclusion+- Fix build failure for stackage inclusion [#20] ### 0.7.0.2
System/Console/Docopt/ApplicativeParsec.hs view
@@ -8,5 +8,4 @@ ) where import Control.Applicative hiding (optional, (<|>))-import Control.Monad (MonadPlus(..), ap) import Text.ParserCombinators.Parsec hiding (many)
System/Console/Docopt/ParseUtils.hs view
@@ -15,6 +15,7 @@ -- * Constants +lowers, uppers, letters, numerics, specialChars, alphanumerics, alphanumSpecial :: String lowers = ['a'..'z'] uppers = ['A'..'Z'] letters = lowers++uppers@@ -27,7 +28,7 @@ -- * Basic Parsers caseInsensitive :: String -> CharParser u String-caseInsensitive = sequence . (map (\c -> (char $ toLower c) <|> (char $ toUpper c)))+caseInsensitive = mapM (\c -> char (toLower c) <|> char (toUpper c)) lookAhead_ :: CharParser u a -> CharParser u () lookAhead_ p = do lookAhead p@@ -37,8 +38,8 @@ isNotFollowedBy p = option False (notFollowedBy p >> return True) isInlineSpace :: Char -> Bool-isInlineSpace c = not (c `elem` "\n\r") - && (isSpace c)+isInlineSpace c = notElem c "\n\r"+ && isSpace c inlineSpace :: CharParser u Char inlineSpace = satisfy isInlineSpace@@ -57,36 +58,40 @@ spaces1 = skipMany1 (satisfy isSpace) <?> ">=1 spaces" +endline :: CharParser u Char endline = inlineSpaces >> newline-optionalEndline = inlineSpaces >> (optional newline) +optionalEndline :: CharParser u ()+optionalEndline = inlineSpaces >> optional newline++pipe :: CharParser u Char pipe = char '|' <?> "'|'" ellipsis :: CharParser u String ellipsis = inlineSpaces >> string "..." <?> "'...'" -+manyTill1 :: CharParser u a -> CharParser u b -> CharParser u [a] manyTill1 p end = do- first <- p + first <- p rest <- manyTill p end return $ first : rest --- |@skipUntil p@ ignores everything that comes before `p`. +-- |@skipUntil p@ ignores everything that comes before `p`. -- Returns what `p` returns. skipUntil :: Show a => CharParser u a -> CharParser u () skipUntil p = skipMany (notFollowedBy p >> anyChar) pGroup :: Char -> CharParser u a -> Char -> CharParser u [a]-pGroup beg elemParser end = between (char beg) (inlineSpaces >> char end) - $ (inlineSpaces >> notFollowedBy pipe >> elemParser) +pGroup beg elemParser end = between (char beg) (inlineSpaces >> char end)+ $ (inlineSpaces >> notFollowedBy pipe >> elemParser) `sepBy` (inlineSpaces >> pipe) betweenS :: String -> String -> CharParser u a -> CharParser u [a] betweenS b e p = between begin end manyP where begin = try $ string b- end = try $ inlineSpaces >> (string e)+ end = try $ inlineSpaces >> string e manyP = p `sepBy` inlineSpaces1
System/Console/Docopt/Types.hs view
@@ -1,12 +1,10 @@ module System.Console.Docopt.Types where -import Data.Ord (comparing) import Data.Map (Map) import qualified Data.Map as M import Data.List (nub) -import System.Console.Docopt.ParseUtils -- * Usage expression Types @@ -21,9 +19,9 @@ deriving (Show, Eq) atoms :: Eq a => Pattern a -> [a]-atoms (Sequence ps) = foldl (++) [] $ map atoms ps-atoms (OneOf ps) = foldl (++) [] $ map atoms $ nub ps-atoms (Unordered ps) = foldl (++) [] $ map atoms $ nub ps+atoms (Sequence ps) = concatMap atoms ps+atoms (OneOf ps) = concatMap atoms $ nub ps+atoms (Unordered ps) = concatMap atoms $ nub ps atoms (Optional p) = atoms p atoms (Repeated p) = atoms p atoms (Atom a) = [a]
System/Console/Docopt/UsageParse.hs view
@@ -1,7 +1,6 @@-module System.Console.Docopt.UsageParse +module System.Console.Docopt.UsageParse where -import Data.Map (Map) import qualified Data.Map as M import Data.Ord (comparing) import GHC.Exts (Down(..))@@ -12,7 +11,7 @@ -- * Helpers --- | Flattens the top level of a Pattern, as long as that +-- | Flattens the top level of a Pattern, as long as that -- /does not/ alter the matching semantics of the Pattern flatten :: Pattern a -> Pattern a flatten (Sequence (x:[])) = x@@ -20,11 +19,14 @@ flatten (Unordered (x:[])) = x flatten x = x +flatSequence :: [Pattern a] -> Pattern a flatSequence = flatten . Sequence++flatOneOf :: [Pattern a] -> Pattern a flatOneOf = flatten . OneOf --- * Pattern Parsers +-- * Pattern Parsers pLine :: CharParser OptInfoMap OptPattern pLine = flatten . OneOf <$> pSeq `sepBy1` (inlineSpaces >> pipe)@@ -40,25 +42,24 @@ pReqGroup = pGroup '(' pExpSeq ')' saveOptionsExpectVal :: (a -> Option) -> [(a, Bool)] -> CharParser OptInfoMap ()-saveOptionsExpectVal t pairs = do- updateState $ \st -> foldl save st pairs+saveOptionsExpectVal t pairs = updateState $ \st -> foldl save st pairs where save infomap (name, optExpectsVal) = M.alter alterFn opt infomap where opt = t name alterFn oldval = Just $ case oldval of- Just oldinfo -> oldinfo {expectsVal = optExpectsVal || (expectsVal oldinfo)}+ Just oldinfo -> oldinfo {expectsVal = optExpectsVal || expectsVal oldinfo} Nothing -> (fromSynList [opt]) {expectsVal = optExpectsVal} pShortOption :: CharParser OptInfoMap (Char, Bool)-pShortOption = try $ do char '-' - ch <- letter +pShortOption = try $ do char '-'+ ch <- letter expectsVal <- pOptionArgument return (ch, expectsVal) pStackedShortOption :: CharParser OptInfoMap OptPattern-pStackedShortOption = try $ do +pStackedShortOption = try $ do char '-'- chars <- many1 $ letter+ chars <- many1 letter lastExpectsVal <- pOptionArgument let (firstChars, lastChar) = (init chars, last chars) firstPairs = map (\x -> (x,False)) firstChars@@ -70,8 +71,8 @@ _ -> return $ Unordered $ map (Atom . ShortOption) chars pLongOption :: CharParser OptInfoMap (Name, Bool)-pLongOption = try $ do - string "--" +pLongOption = try $ do+ string "--" name <- many1 $ oneOf alphanumerics expectsVal <- pOptionArgument --let expectsVal = False@@ -81,20 +82,20 @@ pAnyOption = try (string "options") pOptionArgument :: CharParser OptInfoMap Bool -- True if one is encountered, else False-pOptionArgument = option False $ try $ do - (try $ char '=') <|> try inlineSpace+pOptionArgument = option False $ try $ do+ try (char '=') <|> try inlineSpace notFollowedBy (char '-') try pArgument <|> try (many1 $ oneOf alphanumerics) return True pArgument :: CharParser OptInfoMap String-pArgument = (try bracketStyle) <|> (try upperStyle) +pArgument = try bracketStyle <|> try upperStyle where bracketStyle = do- open <- char '<' + open <- char '<' name <- many $ oneOf alphanumSpecial close <- char '>' return name- upperStyle = do + upperStyle = do first <- oneOf uppers rest <- many $ oneOf $ uppers ++ numerics return $ first:rest@@ -104,16 +105,16 @@ -- '<arg>...' make an OptPattern Repeated if followed by ellipsis repeatable :: CharParser OptInfoMap OptPattern -> CharParser OptInfoMap OptPattern-repeatable p = do +repeatable p = do expct <- p- tryRepeat <- ((try $ (optional inlineSpace) >> ellipsis) >> (return Repeated)) <|> (return id)+ tryRepeat <- (try (optional inlineSpace >> ellipsis) >> return Repeated) <|> return id return (tryRepeat expct) pExp :: CharParser OptInfoMap OptPattern pExp = inlineSpaces >> repeatable value where value = flatOneOf <$> pReqGroup -- <|> Optional . flatten . OneOf <$> betweenS "[(" ")]" pLine- <|> flatten . Sequence . (map Optional) <$> try (betweenS "[" "]" pExp)+ <|> flatten . Sequence . map Optional <$> try (betweenS "[" "]" pExp) <|> Optional . flatten . OneOf <$> pOptGroup <|> return (Atom AnyOption) <* pAnyOption <|> pStackedShortOption@@ -132,9 +133,9 @@ -- | Ignores leading spaces and first word, then parses -- the rest of the usage line pUsageLine :: CharParser OptInfoMap OptPattern-pUsageLine = +pUsageLine = try $ do- inlineSpaces + inlineSpaces many1 (satisfy (not . isSpace)) -- prog name pLine @@ -143,7 +144,7 @@ many (notFollowedBy pUsageHeader >> anyChar) pUsageHeader optionalEndline- usageLines <- (pUsageLine `sepEndBy` endline)+ usageLines <- pUsageLine `sepEndBy` endline return $ flatten . OneOf $ usageLines -- * Option Synonyms & Defaults Parsers@@ -154,10 +155,10 @@ begOptionLine = inlineSpaces >> lookAhead (char '-') >> return "-" pOptSynonyms :: CharParser OptInfoMap ([Option], Bool)-pOptSynonyms = do inlineSpaces +pOptSynonyms = do inlineSpaces pairs <- p `sepEndBy1` (optional (char ',') >> inlineSpace) let options = map fst pairs- expectsVal = or $ map snd pairs+ expectsVal = any snd pairs return (options, expectsVal) where p = (\(c, ev) -> (ShortOption c, ev)) <$> pShortOption <|> (\(s, ev) -> (LongOption s, ev)) <$> pLongOption@@ -173,18 +174,17 @@ pOptDefault :: CharParser OptInfoMap (Maybe String) pOptDefault = do skipUntil (pDefaultTag <|> (newline >> begOptionLine))- maybeDefault <- optionMaybe pDefaultTag- return maybeDefault+ optionMaybe pDefaultTag pOptDescription :: CharParser OptInfoMap () pOptDescription = try $ do (syns, expectsVal) <- pOptSynonyms def <- pOptDefault skipUntil (newline >> begOptionLine)- updateState $ \infomap -> + updateState $ \infomap -> let optinfo = (fromSynList syns) {defaultVal = def, expectsVal = expectsVal} saveOptInfo infomap expct = M.insert expct optinfo infomap- in foldl saveOptInfo infomap syns + in foldl saveOptInfo infomap syns return () pOptDescriptions :: CharParser OptInfoMap OptInfoMap@@ -196,14 +196,14 @@ -- | Main usage parser: parses all of the usage lines into an Exception,--- and all of the option descriptions along with any accompanying +-- and all of the option descriptions along with any accompanying -- defaults, and returns both in a tuple pDocopt :: CharParser OptInfoMap OptFormat pDocopt = do optPattern <- pUsagePatterns optInfoMap <- pOptDescriptions let optPattern' = eagerSort $ expectSynonyms optInfoMap optPattern- saveCanRepeat pat el minfo = case minfo of + 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@@ -221,26 +221,26 @@ expectSynonyms oim a@(Atom atom) = case atom of e@(Command ex) -> a e@(Argument ex) -> a- e@(AnyOption) -> flatten $ Unordered $ nub $ map Atom $ concat $ map synonyms (M.elems oim)- e@(LongOption ex) -> + e@AnyOption -> flatten $ Unordered $ nub $ map Atom $ concatMap synonyms (M.elems oim)+ e@(LongOption ex) -> case synonyms <$> e `M.lookup` oim of Just syns -> flatten . OneOf $ map Atom syns Nothing -> a- e@(ShortOption c) -> + e@(ShortOption c) -> case synonyms <$> e `M.lookup` oim of Just syns -> flatten . OneOf $ map Atom syns Nothing -> a canRepeat :: Eq a => Pattern a -> a -> Bool-canRepeat pat target = +canRepeat pat target = case pat of (Sequence ps) -> canRepeatInside ps || (atomicOccurrences ps > 1)- (OneOf ps) -> foldl (||) False $ map ((flip canRepeat) target) ps+ (OneOf ps) -> canRepeatInside ps (Unordered ps) -> canRepeatInside ps || (atomicOccurrences ps > 1) (Optional p) -> canRepeat p target- (Repeated p) -> target `elem` (atoms pat)+ (Repeated p) -> target `elem` atoms pat (Atom a) -> False- where canRepeatInside ps = foldl (||) False $ map ((flip canRepeat) target) ps + where canRepeatInside = any (`canRepeat` target) atomicOccurrences ps = length $ filter (== target) $ atoms $ Sequence ps @@ -250,7 +250,7 @@ -- LongOption "option" > ShortOption 'o' == True -- Command "cmd" > Argument "arg" == True compareOptSpecificity :: Option -> Option -> Ordering-compareOptSpecificity optA optB = case optA of +compareOptSpecificity optA optB = case optA of LongOption a -> case optB of LongOption b -> comparingFirst length a b _ -> GT@@ -258,38 +258,38 @@ LongOption b -> LT ShortOption b -> compare a b _ -> GT- Command a -> case optB of + Command a -> case optB of LongOption b -> LT ShortOption b -> LT Command b -> comparingFirst length a b _ -> GT- Argument a -> case optB of + Argument a -> case optB of AnyOption -> GT Argument b -> comparingFirst length a b _ -> LT- AnyOption -> case optB of + AnyOption -> case optB of AnyOption -> EQ _ -> LT- where + where comparingFirst :: (Ord a, Ord b) => (a -> b) -> a -> a -> Ordering- comparingFirst p a1 a2 = + comparingFirst p a1 a2 = case compare (p a1) (p a2) of EQ -> compare a1 a2 o -> o -- | Sort an OptPattern such that more-specific patterns come first,--- while leaving the semantics of the pattern structure unchanged. +-- while leaving the semantics of the pattern structure unchanged. eagerSort :: OptPattern -> OptPattern-eagerSort pat = +eagerSort pat = case pat of Sequence ps -> Sequence $ map eagerSort ps OneOf ps -> OneOf $ map eagerSort- . sortBy (comparing $ Down . maxLength) + . sortBy (comparing $ Down . maxLength) . sortBy (comparing representativeAtom) $ ps Unordered ps -> Unordered $ map eagerSort ps Optional p -> Optional $ eagerSort p- Repeated p -> Repeated $ eagerSort p + Repeated p -> Repeated $ eagerSort p a@(Atom _) -> a where representativeAtom :: OptPattern -> Option@@ -307,7 +307,7 @@ Unordered ps -> sum $ map maxLength ps Optional p -> maxLength p Repeated p -> maxLength p- Atom a -> case a of + Atom a -> case a of LongOption o -> length o ShortOption _ -> 1 Command c -> length c
docopt.cabal view
@@ -1,5 +1,5 @@ name: docopt-version: 0.7.0.3+version: 0.7.0.4 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. @@ -20,6 +20,8 @@ extra-source-files: README.md CHANGELOG.md +data-files: test/testcases.docopt+ source-repository head type: git location: https://github.com/docopt/docopt.hs.git@@ -44,7 +46,11 @@ parsec == 3.1.*, containers - ghc-options: -Wall -fno-warn-unused-do-bind+ ghc-options: -Wall+ -fno-warn-unused-binds+ -fno-warn-unused-do-bind+ -fno-warn-unused-matches+ -fno-warn-name-shadowing if impl(ghc >= 6.10) && flag(template-haskell) exposed-modules: System.Console.Docopt@@ -58,18 +64,29 @@ hs-source-dirs: ./, test main-is: LangAgnosticTests.hs + ghc-options: -Wall+ -fno-warn-unused-binds+ -fno-warn-unused-do-bind+ -fno-warn-unused-matches+ -fno-warn-name-shadowing+ -fno-warn-orphans+ build-depends: base == 4.*, parsec == 3.1.*, containers, docopt,- split,- ansi-terminal,- aeson,+ HUnit,+ split >= 0.2.2,+ ansi-terminal >= 0.6,+ aeson >= 0.8, bytestring == 0.10.*, template-haskell, th-lift - other-modules: System.Console.Docopt.Types,+ 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.OptParse,+ System.Console.Docopt.Public,+ Paths_docopt
test/LangAgnosticTests.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} -import Control.Monad (when, unless)+import Control.Monad ( (>=>) ) import System.Exit import System.Console.ANSI---import System.Directory import System.Console.Docopt import System.Console.Docopt.Types@@ -15,75 +14,158 @@ import qualified Data.Map as M import Data.List.Split-import Data.Char (isSpace) import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BS +import Test.HUnit+import Paths_docopt (getDataFileName) -instance ToJSON ArgValue where - toJSON x = case x of ++instance ToJSON ArgValue where+ toJSON x = case x of MultiValue vs -> toJSON $ reverse vs Value v -> toJSON v NoValue -> toJSON Null Counted n -> toJSON n Present -> toJSON True- NotPresent -> toJSON False + NotPresent -> toJSON False instance ToJSON (Map Option ArgValue) where- toJSON argmap = + toJSON argmap = let argmap' = M.mapKeys humanize argmap in toJSON argmap' coloredString :: Color -> String -> String-coloredString c str = (setSGRCode [SetColor Foreground Dull c]) ++- str ++ - (setSGRCode [Reset])+coloredString c str = setSGRCode [SetColor Foreground Dull c]+ ++ str+ ++ setSGRCode [Reset] +green, red, yellow, blue, magenta :: String -> String green = coloredString Green red = coloredString Red-yellow = coloredString Yellow +yellow = coloredString Yellow blue = coloredString Blue magenta = coloredString Magenta -forEach xs = sequence_ . (flip map) xs +main :: IO ()+main = do+ f <- (getDataFileName >=> readFile) "test/testcases.docopt"+ tests <- testsFromDocoptSpecFile "testcases.docopt" f blacklist+ counts <- runTestTT $ TestList tests+ exitWith $ if failures counts > 0+ then ExitFailure 1+ else ExitSuccess -main = do - --putStrLn =<< getCurrentDirectory- testFile <- readFile "test/testcases.docopt"- --putStrLn rawTests- let notCommentLine x = (null x) || ('#' /= head x)+blacklist :: (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+-- Partial-option disambiguation+blacklist (4, 2) = True+blacklist (6, 3) = True+blacklist (6, 4) = True+blacklist (12, 4) = True+-- Stacked short options/flags disambiguation+blacklist (14, 1) = True+blacklist (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 ("<arg>" 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+-- Weirdly broken (argument capture; should fix)+blacklist (33, 2) = True+blacklist (33, 3) = True+blacklist (34, 3) = True+-- [options] expansion pruning (should fix)+blacklist (67, 1) = True+blacklist _ = False++testsFromDocoptSpecFile :: String+ -> String+ -> ((Int, Int) -> Bool)+ -> IO [Test]+testsFromDocoptSpecFile name testFile ignore =+ let notCommentLine x = null x || ('#' /= head x) testFileClean = unlines $ filter notCommentLine $ lines testFile caseGroups = filter (not . null) $ splitOn "r\"\"\"" testFileClean- --putStrLn $ head caseGroups- forEach caseGroups $ \caseGroup -> do++ in+ return . (:[]) . TestLabel name . test $ zip caseGroups [(1 :: Int)..] >>= \(caseGroup, icg) -> do+ let [usage, rawCases] = splitOn "\"\"\"" caseGroup cases = filter (/= "\n") $ splitOn "$ " rawCases- optFormat <- case runParser pDocopt M.empty "Usage" usage of- Left e -> do- putStrLn "couldn't parse usage text"- return (Sequence [], M.empty)- Right o -> return o- putStrLn $ "Docopt:\n" ++ blue usage- putStrLn $ "Pattern:\n" ++ magenta (show optFormat)- --putStrLn $ "Cases: " ++ show cases- forEach cases $ \testcase -> do++ let (optFormat, docParseMsg) = case runParser pDocopt M.empty "Usage" usage of+ Left e -> ((Sequence [], M.empty), "Couldn't parse usage text")+ Right o -> (o, "")++ let groupDescLines = [+ docParseMsg,+ "Docopt:",+ blue usage,+ "Pattern:",+ magenta (show optFormat)+ ]++ zip cases [(1::Int)..] >>= \(testcase, itc) -> do+ let (cmdline, rawTarget_) = break (== '\n') testcase rawTarget = filter (/= '\n') rawTarget_ maybeTargetJSON = decode (BS.pack rawTarget) :: Maybe Value rawArgs = tail $ words cmdline- parsedArgs <- case getArguments optFormat rawArgs of- Left e -> do- putStrLn $ "Parse Error: " ++ (red $ show e)- return M.empty- Right a -> return a++ let (parsedArgs, argParseMsg) = case getArguments optFormat rawArgs of+ Left e -> (M.empty, "Parse Error: " ++ red (show e) ++ "\n")+ Right a -> (a, "")+ let parsedArgsJSON = toJSON parsedArgs- testCaseSuccess = if (rawTarget == "\"user-error\"")+ testCaseEquality = if rawTarget == "\"user-error\"" then M.null parsedArgs- else (maybeTargetJSON == Just parsedArgsJSON)- putStrLn $ "Case Cmd: " ++ yellow cmdline- putStrLn $ "Case Target: " ++ (if testCaseSuccess then green else magenta) rawTarget- unless testCaseSuccess $- putStrLn $ "Failure: " ++ red (BS.unpack $ encode parsedArgsJSON)- putStrLn ""- exitSuccess+ else maybeTargetJSON == Just parsedArgsJSON+ blacklisted = blacklist (icg, itc)+ testCaseSuccess = if blacklisted+ then not testCaseEquality+ else testCaseEquality++ let testDescLines = [+ "Cmd: " ++ yellow cmdline,+ "Target: " ++ (if testCaseSuccess then green else magenta) rawTarget+ ]++ let testMsg = unlines . filter (not . null) $+ groupDescLines+ ++ testDescLines+ ++ ["(Blacklisted)" | blacklisted]+ ++ ["Failure: " ++ red (BS.unpack $ encode parsedArgsJSON)]++ let ti = TestCase $ testCaseSuccess @? testMsg++ return $ TestLabel ("group-" ++ show icg ++ "-case-" ++ show itc) ti
+ test/testcases.docopt view
@@ -0,0 +1,930 @@+r"""Usage: prog++"""+$ prog+{}++$ prog --xxx+"user-error"+++r"""Usage: prog [options]++-a All.++"""+$ prog+{"-a": false}++$ prog -a+{"-a": true}++$ prog -x+"user-error"+++r"""Usage: prog [options]++--all All.++"""+$ prog+{"--all": false}++$ prog --all+{"--all": true}++$ prog --xxx+"user-error"+++r"""Usage: prog [options]++-v, --verbose Verbose.++"""+$ prog --verbose+{"--verbose": true}++$ prog --ver+{"--verbose": true}++$ prog -v+{"--verbose": true}+++r"""Usage: prog [options]++-p PATH++"""+$ prog -p home/+{"-p": "home/"}++$ prog -phome/+{"-p": "home/"}++$ prog -p+"user-error"+++r"""Usage: prog [options]++--path <path>++"""+$ prog --path home/+{"--path": "home/"}++$ prog --path=home/+{"--path": "home/"}++$ prog --pa home/+{"--path": "home/"}++$ prog --pa=home/+{"--path": "home/"}++$ prog --path+"user-error"+++r"""Usage: prog [options]++-p PATH, --path=<path> Path to files.++"""+$ prog -proot+{"--path": "root"}+++r"""Usage: prog [options]++ -p --path PATH Path to files.++"""+$ prog -p root+{"--path": "root"}++$ prog --path root+{"--path": "root"}+++r"""Usage: prog [options]++-p PATH Path to files [default: ./]++"""+$ prog+{"-p": "./"}++$ prog -phome+{"-p": "home"}+++r"""UsAgE: prog [options]++--path=<files> Path to files+ [dEfAuLt: /root]++"""+$ prog+{"--path": "/root"}++$ prog --path=home+{"--path": "home"}+++r"""usage: prog [options]++-a Add+-r Remote+-m <msg> Message++"""+$ prog -a -r -m Hello+{"-a": true,+ "-r": true,+ "-m": "Hello"}++$ prog -armyourass+{"-a": true,+ "-r": true,+ "-m": "yourass"}++$ prog -a -r+{"-a": true,+ "-r": true,+ "-m": null}+++r"""Usage: prog [options]++--version+--verbose++"""+$ prog --version+{"--version": true,+ "--verbose": false}++$ prog --verbose+{"--version": false,+ "--verbose": true}++$ prog --ver+"user-error"++$ prog --verb+{"--version": false,+ "--verbose": true}+++r"""usage: prog [-a -r -m <msg>]++-a Add+-r Remote+-m <msg> Message++"""+$ prog -armyourass+{"-a": true,+ "-r": true,+ "-m": "yourass"}+++r"""usage: prog [-armmsg]++-a Add+-r Remote+-m <msg> Message++"""+$ prog -a -r -m Hello+{"-a": true,+ "-r": true,+ "-m": "Hello"}+++r"""usage: prog -a -b++-a+-b++"""+$ prog -a -b+{"-a": true, "-b": true}++$ prog -b -a+{"-a": true, "-b": true}++$ prog -a+"user-error"++$ prog+"user-error"+++r"""usage: prog (-a -b)++-a+-b++"""+$ prog -a -b+{"-a": true, "-b": true}++$ prog -b -a+{"-a": true, "-b": true}++$ prog -a+"user-error"++$ prog+"user-error"+++r"""usage: prog [-a] -b++-a+-b++"""+$ prog -a -b+{"-a": true, "-b": true}++$ prog -b -a+{"-a": true, "-b": true}++$ prog -a+"user-error"++$ prog -b+{"-a": false, "-b": true}++$ prog+"user-error"+++r"""usage: prog [(-a -b)]++-a+-b++"""+$ prog -a -b+{"-a": true, "-b": true}++$ prog -b -a+{"-a": true, "-b": true}++$ prog -a+"user-error"++$ prog -b+"user-error"++$ prog+{"-a": false, "-b": false}+++r"""usage: prog (-a|-b)++-a+-b++"""+$ prog -a -b+"user-error"++$ prog+"user-error"++$ prog -a+{"-a": true, "-b": false}++$ prog -b+{"-a": false, "-b": true}+++r"""usage: prog [ -a | -b ]++-a+-b++"""+$ prog -a -b+"user-error"++$ prog+{"-a": false, "-b": false}++$ prog -a+{"-a": true, "-b": false}++$ prog -b+{"-a": false, "-b": true}+++r"""usage: prog <arg>++"""+$ prog 10+{"<arg>": "10"}++$ prog 10 20+"user-error"++$ prog+"user-error"+++r"""usage: prog [<arg>]++"""+$ prog 10+{"<arg>": "10"}++$ prog 10 20+"user-error"++$ prog+{"<arg>": null}+++r"""usage: prog <kind> <name> <type>++"""+$ prog 10 20 40+{"<kind>": "10", "<name>": "20", "<type>": "40"}++$ prog 10 20+"user-error"++$ prog+"user-error"+++r"""usage: prog <kind> [<name> <type>]++"""+$ prog 10 20 40+{"<kind>": "10", "<name>": "20", "<type>": "40"}++$ prog 10 20+{"<kind>": "10", "<name>": "20", "<type>": null}++$ prog+"user-error"+++r"""usage: prog [<kind> | <name> <type>]++"""+$ prog 10 20 40+"user-error"++$ prog 20 40+{"<kind>": null, "<name>": "20", "<type>": "40"}++$ prog+{"<kind>": null, "<name>": null, "<type>": null}+++r"""usage: prog (<kind> --all | <name>)++--all++"""+$ prog 10 --all+{"<kind>": "10", "--all": true, "<name>": null}++$ prog 10+{"<kind>": null, "--all": false, "<name>": "10"}++$ prog+"user-error"+++r"""usage: prog [<name> <name>]++"""+$ prog 10 20+{"<name>": ["10", "20"]}++$ prog 10+{"<name>": ["10"]}++$ prog+{"<name>": []}+++r"""usage: prog [(<name> <name>)]++"""+$ prog 10 20+{"<name>": ["10", "20"]}++$ prog 10+"user-error"++$ prog+{"<name>": []}+++r"""usage: prog NAME...++"""+$ prog 10 20+{"NAME": ["10", "20"]}++$ prog 10+{"NAME": ["10"]}++$ prog+"user-error"+++r"""usage: prog [NAME]...++"""+$ prog 10 20+{"NAME": ["10", "20"]}++$ prog 10+{"NAME": ["10"]}++$ prog+{"NAME": []}+++r"""usage: prog [NAME...]++"""+$ prog 10 20+{"NAME": ["10", "20"]}++$ prog 10+{"NAME": ["10"]}++$ prog+{"NAME": []}+++r"""usage: prog [NAME [NAME ...]]++"""+$ prog 10 20+{"NAME": ["10", "20"]}++$ prog 10+{"NAME": ["10"]}++$ prog+{"NAME": []}+++r"""usage: prog (NAME | --foo NAME)++--foo++"""+$ prog 10+{"NAME": "10", "--foo": false}++$ prog --foo 10+{"NAME": "10", "--foo": true}++$ prog --foo=10+"user-error"+++r"""usage: prog (NAME | --foo) [--bar | NAME]++--foo+--bar++"""+$ prog 10+{"NAME": ["10"], "--foo": false, "--bar": false}++$ prog 10 20+{"NAME": ["10", "20"], "--foo": false, "--bar": false}++$ prog --foo --bar+{"NAME": [], "--foo": true, "--bar": true}+++r"""Naval Fate.++Usage:+ prog ship new <name>...+ prog ship [<name>] move <x> <y> [--speed=<kn>]+ prog ship shoot <x> <y>+ prog mine (set|remove) <x> <y> [--moored|--drifting]+ prog -h | --help+ prog --version++Options:+ -h --help Show this screen.+ --version Show version.+ --speed=<kn> Speed in knots [default: 10].+ --moored Mored (anchored) mine.+ --drifting Drifting mine.++"""+$ prog ship Guardian move 150 300 --speed=20+{"--drifting": false,+ "--help": false,+ "--moored": false,+ "--speed": "20",+ "--version": false,+ "<name>": ["Guardian"],+ "<x>": "150",+ "<y>": "300",+ "mine": false,+ "move": true,+ "new": false,+ "remove": false,+ "set": false,+ "ship": true,+ "shoot": false}+++r"""usage: prog --hello++"""+$ prog --hello+{"--hello": true}+++r"""usage: prog [--hello=<world>]++"""+$ prog+{"--hello": null}++$ prog --hello wrld+{"--hello": "wrld"}+++r"""usage: prog [-o]++"""+$ prog+{"-o": false}++$ prog -o+{"-o": true}+++r"""usage: prog [-opr]++"""+$ prog -op+{"-o": true, "-p": true, "-r": false}+++r"""usage: prog --aabb | --aa++"""+$ prog --aa+{"--aabb": false, "--aa": true}++$ prog --a+"user-error"++#+# Counting number of flags+#++r"""Usage: prog -v++"""+$ prog -v+{"-v": true}+++r"""Usage: prog [-v -v]++"""+$ prog+{"-v": 0}++$ prog -v+{"-v": 1}++$ prog -vv+{"-v": 2}+++r"""Usage: prog -v ...++"""+$ prog+"user-error"++$ prog -v+{"-v": 1}++$ prog -vv+{"-v": 2}++$ prog -vvvvvv+{"-v": 6}+++r"""Usage: prog [-v | -vv | -vvv]++This one is probably most readable user-friednly variant.++"""+$ prog+{"-v": 0}++$ prog -v+{"-v": 1}++$ prog -vv+{"-v": 2}++$ prog -vvvv+"user-error"+++r"""usage: prog [--ver --ver]++"""+$ prog --ver --ver+{"--ver": 2}+++#+# Counting commands+#++r"""usage: prog [go]++"""+$ prog go+{"go": true}+++r"""usage: prog [go go]++"""+$ prog+{"go": 0}++$ prog go+{"go": 1}++$ prog go go+{"go": 2}++$ prog go go go+"user-error"++r"""usage: prog go...++"""+$ prog go go go go go+{"go": 5}++#+# Test [options] shourtcut+#++r"""Usage: prog [options] A++ -q Be quiet+ -v Be verbose.++"""+$ prog arg+{"A": "arg", "-v": false, "-q": false}++$ prog -v arg+{"A": "arg", "-v": true, "-q": false}++$ prog -q arg+{"A": "arg", "-v": false, "-q": true}++#+# Test single dash+#++r"""usage: prog [-]"""+$ prog -+{"-": true}++$ prog+{"-": false}++#+# If argument is repeated, its value should always be a list+#++r"""usage: prog [NAME [NAME ...]]"""+$ prog a b+{"NAME": ["a", "b"]}++$ prog+{"NAME": []}++#+# Option's argument defaults to null/None+#++r"""usage: prog [options]++-a Add+-m <msg> Message++"""+$ prog -a+{"-m": null, "-a": true}++#+# Test options without description+#++r"""usage: prog --hello"""+$ prog --hello+{"--hello": true}++r"""usage: prog [--hello=<world>]"""+$ prog+{"--hello": null}++$ prog --hello wrld+{"--hello": "wrld"}++r"""usage: prog [-o]"""+$ prog+{"-o": false}++$ prog -o+{"-o": true}++r"""usage: prog [-opr]"""+$ prog -op+{"-o": true, "-p": true, "-r": false}++r"""usage: git [-v | --verbose]"""+$ prog -v+{"-v": true, "--verbose": false}++r"""usage: git remote [-v | --verbose]"""+$ prog remote -v+{"remote": true, "-v": true, "--verbose": false}++#+# Test empty usage pattern+#++r"""usage: prog"""+$ prog+{}++r"""usage: prog+ prog <a> <b>+"""+$ prog 1 2+{"<a>": "1", "<b>": "2"}++$ prog+{"<a>": null, "<b>": null}++r"""usage: prog <a> <b>+ prog+"""+$ prog+{"<a>": null, "<b>": null}++#+# Option's argument should not capture default value from usage pattern+#++r"""usage: prog [--file=<f>]"""+$ prog+{"--file": null}++r"""usage: prog [--file=<f>]++--file <a>++"""+$ prog+{"--file": null}++r"""Usage: prog [-a <host:port>]++-a, --address <host:port> TCP address [default: localhost:6283].++"""+$ prog+{"--address": "localhost:6283"}++#+# If option with argument could be repeated,+# its arguments should be accumulated into a list+#++r"""usage: prog --long=<arg> ..."""+$ prog --long one+{"--long": ["one"]}++$ prog --long one --long two+{"--long": ["one", "two"]}++#+# Test multiple elements repeated at once+#++r"""usage: prog (go <direction> --speed=<km/h>)..."""+$ prog go left --speed=5 go right --speed=9+{"go": 2, "<direction>": ["left", "right"], "--speed": ["5", "9"]}++#+# Required options should work with option shortcut+#++r"""usage: prog [options] -a++-a++"""+$ prog -a+{"-a": true}++#+# If option could be repeated its defaults should be split into a list+#++r"""usage: prog [-o <o>]...++-o <o> [default: x]++"""+$ prog -o this -o that+{"-o": ["this", "that"]}++$ prog+{"-o": ["x"]}++r"""usage: prog [-o <o>]...++-o <o> [default: x y]++"""+$ prog -o this+{"-o": ["this"]}++$ prog+{"-o": ["x", "y"]}++#+# Test stacked option's argument+#++r"""usage: prog -pPATH++-p PATH++"""+$ prog -pHOME+{"-p": "HOME"}++#+# Issue 56: Repeated mutually exclusive args give nested lists sometimes+#++r"""Usage: foo (--xx=x|--yy=y)..."""+$ prog --xx=1 --yy=2+{"--xx": ["1"], "--yy": ["2"]}++#+# POSIXly correct tokenization+#++r"""usage: prog [<input file>]"""+$ prog f.txt+{"<input file>": "f.txt"}++r"""usage: prog [--input=<file name>]..."""+$ prog --input a.txt --input=b.txt+{"--input": ["a.txt", "b.txt"]}++#+# Issue 85: `[options]` shourtcut with multiple subcommands+#++r"""usage: prog good [options]+ prog fail [options]++--loglevel=N++"""+$ prog fail --loglevel 5+{"--loglevel": "5", "fail": true, "good": false}