Use the same command table for both parsing and help

This commit is contained in:
Marshall Bowers 2020-03-26 22:17:15 -04:00
parent 290db90025
commit 9701a178b5

View File

@ -1504,14 +1504,20 @@ editCmd
export export
data CmdArg : Type where data CmdArg : Type where
||| The command takes no arguments.
NoArg : CmdArg
||| The command takes a name.
NameArg : CmdArg
||| The command takes an expression. ||| The command takes an expression.
ExprArg : CmdArg ExprArg : CmdArg
NoArg : CmdArg
export export
Show CmdArg where Show CmdArg where
show ExprArg = "<expr>"
show NoArg = "" show NoArg = ""
show NameArg = "<name>"
show ExprArg = "<expr>"
CommandDefinition : Type CommandDefinition : Type
CommandDefinition = (List String, CmdArg, String, Rule REPLCmd) CommandDefinition = (List String, CmdArg, String, Rule REPLCmd)
@ -1519,18 +1525,49 @@ CommandDefinition = (List String, CmdArg, String, Rule REPLCmd)
CommandTable : Type CommandTable : Type
CommandTable = List CommandDefinition CommandTable = List CommandDefinition
exprArg : (PTerm -> REPLCmd) -> Rule REPLCmd eatCommand : List String -> Rule ()
exprArg command = do eatCommand names = do
tm <- expr pdef "(interactive)" init symbol ":"
pure (command tm) replCmd names
noArgCmd : List String -> REPLCmd -> String -> CommandDefinition
noArgCmd names command doc = (names, NoArg, doc, parse)
where
parse = do
eatCommand names
pure command
nameArgCmd : List String -> (Name -> REPLCmd) -> String -> CommandDefinition
nameArgCmd names command doc = (names, NameArg, doc, parse)
where
parse = do
eatCommand names
n <- name
pure (command n)
exprArgCmd : List String -> (PTerm -> REPLCmd) -> String -> CommandDefinition exprArgCmd : List String -> (PTerm -> REPLCmd) -> String -> CommandDefinition
exprArgCmd names command doc = exprArgCmd names command doc = (names, ExprArg, doc, parse)
(names, ExprArg, doc, exprArg command) where
parse = do
eatCommand names
tm <- expr pdef "(interactive)" init
pure (command tm)
parserCommandsForHelp : CommandTable parserCommandsForHelp : CommandTable
parserCommandsForHelp = parserCommandsForHelp =
[ exprArgCmd ["t", "type"] Check "Check the type of an expression" [ exprArgCmd ["t", "type"] Check "Check the type of an expression"
, nameArgCmd ["printdef"] PrintDef "Show the definition of a function"
, nameArgCmd ["s", "search"] ProofSearch "???"
, nameArgCmd ["di"] DebugInfo "???"
, nameArgCmd ["miss", "missing"] Missing "Show missing clauses"
, nameArgCmd ["total"] Total "Check the totality of a name"
, noArgCmd ["h", "help"] Help "Display this help text"
, noArgCmd ["q", "quit", "exit"] Quit "Exit the Idris system"
, noArgCmd ["cwd"] CWD "Displays the current working directory"
, noArgCmd ["version"] ShowVersion "Display the Idris version"
, noArgCmd ["r", "reload"] Reload "Reload current file"
, noArgCmd ["e", "edit"] Edit "Edit current file using $EDITOR or $VISUAL"
, noArgCmd ["m", "metavars"] Metavars "Show remaining proof obligations (metavariables or holes)"
] ]
export export
@ -1539,24 +1576,12 @@ help = (["<expr>"], NoArg, "Evaluate an expression") ::
[ (map (":" ++) names, args, text) | (names, args, text, _) <- parserCommandsForHelp ] [ (map (":" ++) names, args, text) | (names, args, text, _) <- parserCommandsForHelp ]
nonEmptyCommand : Rule REPLCmd nonEmptyCommand : Rule REPLCmd
nonEmptyCommand nonEmptyCommand =
= do symbol ":"; replCmd ["t", "type"] choice [ parser | (_, _, _, parser) <- parserCommandsForHelp ]
tm <- expr pdef "(interactive)" init
pure (Check tm) undocumentedNonEmptyCommand : Rule REPLCmd
<|> do symbol ":"; replCmd ["printdef"] undocumentedNonEmptyCommand
n <- name = do symbol ":"; exactIdent "set"
pure (PrintDef n)
<|> do symbol ":"; replCmd ["s", "search"]
n <- name
pure (ProofSearch n)
<|> do symbol ":"; exactIdent "di"
n <- name
pure (DebugInfo n)
<|> do symbol ":"; replCmd ["q", "quit", "exit"]
pure Quit
<|> do symbol ":"; replCmd ["cwd"]
pure CWD
<|> do symbol ":"; exactIdent "set"
opt <- setOption True opt <- setOption True
pure (SetOpt opt) pure (SetOpt opt)
<|> do symbol ":"; exactIdent "unset" <|> do symbol ":"; exactIdent "unset"
@ -1569,29 +1594,16 @@ nonEmptyCommand
<|> do symbol ":"; exactIdent "exec" <|> do symbol ":"; exactIdent "exec"
tm <- expr pdef "(interactive)" init tm <- expr pdef "(interactive)" init
pure (Exec tm) pure (Exec tm)
<|> do symbol ":"; replCmd ["?", "h", "help"]
pure Help
<|> do symbol ":"; replCmd ["r", "reload"]
pure Reload
<|> do symbol ":"; replCmd ["e", "edit"]
pure Edit
<|> do symbol ":"; replCmd ["miss", "missing"]
n <- name
pure (Missing n)
<|> do symbol ":"; keyword "total"
n <- name
pure (Total n)
<|> do symbol ":"; replCmd ["log", "logging"] <|> do symbol ":"; replCmd ["log", "logging"]
i <- intLit i <- intLit
pure (SetLog (fromInteger i)) pure (SetLog (fromInteger i))
<|> do symbol ":"; replCmd ["m", "metavars"]
pure Metavars
<|> do symbol ":"; replCmd ["version"]
pure ShowVersion
<|> do symbol ":"; cmd <- editCmd <|> do symbol ":"; cmd <- editCmd
pure (Editing cmd) pure (Editing cmd)
<|> do tm <- expr pdef "(interactive)" init
pure (Eval tm) eval : Rule REPLCmd
eval = do
tm <- expr pdef "(interactive)" init
pure (Eval tm)
export export
command : EmptyRule REPLCmd command : EmptyRule REPLCmd
@ -1599,3 +1611,5 @@ command
= do eoi = do eoi
pure NOP pure NOP
<|> nonEmptyCommand <|> nonEmptyCommand
<|> undocumentedNonEmptyCommand
<|> eval