Rewrite getopts style option parser

This commit is contained in:
Vidar Holen 2020-10-18 20:36:48 -07:00
parent 8d99926554
commit f100c2939e
4 changed files with 120 additions and 32 deletions

View file

@ -53,8 +53,6 @@ verify :: CommandCheck -> String -> Bool
verify f s = producesComments (getChecker [f]) s == Just True
verifyNot f s = producesComments (getChecker [f]) s == Just False
arguments (T_SimpleCommand _ _ (cmd:args)) = args
commandChecks :: [CommandCheck]
commandChecks = [
checkTr
@ -116,6 +114,35 @@ prop_verifyOptionalExamples = all check optionalCommandChecks
verify check (cdPositive desc)
&& verifyNot check (cdNegative desc)
-- Run a check against the getopt parser. If it fails, the lists are empty.
checkGetOpts str flags args f =
flags == actualFlags && args == actualArgs
where
toTokens = map (T_Literal (Id 0)) . words
opts = fromMaybe [] $ f (toTokens str)
actualFlags = filter (not . null) $ map fst opts
actualArgs = map (\(_, (_, x)) -> onlyLiteralString x) $ filter (null . fst) opts
-- Short options
prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" []
prop_checkGetOptsS2 = checkGetOpts "-fx" ["f"] [] $ getOpts (True, True) "f:" []
prop_checkGetOptsS3 = checkGetOpts "-f -x" ["f", "x"] [] $ getOpts (True, True) "fx" []
prop_checkGetOptsS4 = checkGetOpts "-f -x" ["f"] [] $ getOpts (True, True) "f:" []
prop_checkGetOptsS5 = checkGetOpts "-fx" [] [] $ getOpts (True, True) "fx:" []
-- Long options
prop_checkGetOptsL1 = checkGetOpts "--foo=bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)]
prop_checkGetOptsL2 = checkGetOpts "--foo bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)]
prop_checkGetOptsL3 = checkGetOpts "--foo baz" ["foo"] ["baz"] $ getOpts (True, True) "" []
prop_checkGetOptsL4 = checkGetOpts "--foo baz" [] [] $ getOpts (True, False) "" []
-- Know when to terminate
prop_checkGetOptsT1 = checkGetOpts "-a x -b" ["a", "b"] ["x"] $ getOpts (True, True) "ab" []
prop_checkGetOptsT2 = checkGetOpts "-a x -b" ["a"] ["x","-b"] $ getOpts (False, True) "ab" []
prop_checkGetOptsT3 = checkGetOpts "-a -- -b" ["a"] ["-b"] $ getOpts (True, True) "ab" []
prop_checkGetOptsT4 = checkGetOpts "-a -- -b" ["a", "b"] [] $ getOpts (True, True) "a:b" []
buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis)
buildCommandMap = foldl' addCheck Map.empty
where
@ -694,8 +721,8 @@ checkReadExpansions = CommandCheck (Exactly "read") check
where
options = getGnuOpts flagsForRead
getVars cmd = fromMaybe [] $ do
opts <- options cmd
return [y | (x,y) <- opts, null x || x == "a"]
opts <- options $ arguments cmd
return [y | (x,(_, y)) <- opts, null x || x == "a"]
check cmd = mapM_ warning $ getVars cmd
warning t = sequence_ $ do
@ -1070,8 +1097,8 @@ prop_checkSudoArgs7 = verifyNot checkSudoArgs "sudo docker export foo"
checkSudoArgs = CommandCheck (Basename "sudo") f
where
f t = sequence_ $ do
opts <- parseOpts t
let nonFlags = [x | ("",x) <- opts]
opts <- parseOpts $ arguments t
let nonFlags = [x | ("",(x, _)) <- opts]
commandArg <- nonFlags !!! 0
command <- getLiteralString commandArg
guard $ command `elem` builtins