git.iko.soy/Idris-dev
on master help sign in
Tab completion for setting colours at the REPL
1085d22David Christiansen
src/Idris/Completion.hs+30
compare with master
unifiedsplit
@@ -7,13 +7,16 @@ import Core.CoreParser (opChars)
7
7
8import Idris.AbsSyntaxTree
8import Idris.AbsSyntaxTree
9import Idris.Help
9import Idris.Help
10+import Idris.Colours
10
11
11import Control.Monad.State.Strict
12import Control.Monad.State.Strict
12
13
13import Data.List
14import Data.List
14import Data.Maybe
15import Data.Maybe
16+import Data.Char(toLower)
15
17
16import System.Console.Haskeline
18import System.Console.Haskeline
19+import System.Console.ANSI (Color)
17
20
18
21
19fst3 :: (a, b, c) -> a
22fst3 :: (a, b, c) -> a
@@ -109,6 +112,32 @@ lookupInHelp cmd = lookupInHelp' cmd help
109 | otherwise = lookupInHelp' cmd xs
112 | otherwise = lookupInHelp' cmd xs
110 lookupInHelp' cmd [] = Nothing
113 lookupInHelp' cmd [] = Nothing
111
114
115+completeColour :: CompletionFunc Idris
116+completeColour (prev, next) = case words (reverse prev) of
117+ [c] | isCmd c -> do cmpls <- completeColourOpt next
118+ return (reverse $ c ++ " ", cmpls)
119+ [c, o] | o `elem` opts -> let correct = (c ++ " " ++ o) in
120+ return (reverse correct, [simpleCompletion ""])
121+ | o `elem` colourTypes -> completeColourFormat (prev, next)
122+ | otherwise -> let cmpls = completeWith (opts ++ colourTypes) o in
123+ let sofar = (c ++ " ") in
124+ return (reverse sofar, cmpls)
125+ cmd@(c:o:_) | isCmd c && o `elem` colourTypes ->
126+ completeColourFormat (prev, next)
127+ _ -> noCompletion (prev, next)
128+ where completeColourOpt :: String -> Idris [Completion]
129+ completeColourOpt = return . completeWith (opts ++ colourTypes)
130+ opts = ["on", "off"]
131+ colourTypes = map (map toLower . reverse . drop 6 . reverse . show) $
132+ enumFromTo (minBound::ColourType) maxBound
133+ isCmd ":colour" = True
134+ isCmd ":color" = True
135+ isCmd _ = False
136+ colours = map (map toLower . show) $ enumFromTo (minBound::Color) maxBound
137+ formats = ["vivid", "dull", "underline", "nounderline", "bold", "nobold"]
138+ completeColourFormat = let getCmpl = completeWith (colours ++ formats) in
139+ completeWord Nothing " \t" (return . getCmpl)
140+
112-- | Get the completion function for a particular command
141-- | Get the completion function for a particular command
113completeCmd :: String -> CompletionFunc Idris
142completeCmd :: String -> CompletionFunc Idris
114completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookupInHelp cmd
143completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookupInHelp cmd
@@ -118,6 +147,7 @@ completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lo
118 completeArg ModuleArg = noCompletion (prev, next) -- FIXME do later
147 completeArg ModuleArg = noCompletion (prev, next) -- FIXME do later
119 completeArg ExprArg = completeExpr [] (prev, next)
148 completeArg ExprArg = completeExpr [] (prev, next)
120 completeArg MetaVarArg = completeMetaVar (prev, next) -- FIXME only complete one name
149 completeArg MetaVarArg = completeMetaVar (prev, next) -- FIXME only complete one name
150+ completeArg ColourArg = completeColour (prev, next)
121 completeArg NoArg = noCompletion (prev, next)
151 completeArg NoArg = noCompletion (prev, next)
122 completeCmdName = return $ ("", completeWith commands cmd)
152 completeCmdName = return $ ("", completeWith commands cmd)
123
153
src/Idris/Help.hs+10−8
@@ -6,17 +6,19 @@ data CmdArg = ExprArg -- ^ The command takes an expression
6 | ModuleArg -- ^ The command takes a module name
6 | ModuleArg -- ^ The command takes a module name
7 | OptionArg -- ^ The command takes an option
7 | OptionArg -- ^ The command takes an option
8 | MetaVarArg -- ^ The command takes a metavariable
8 | MetaVarArg -- ^ The command takes a metavariable
9+ | ColourArg -- ^ The command is the colour-setting command
9 | NoArg -- ^ No completion (yet!?)
10 | NoArg -- ^ No completion (yet!?)
10 | SpecialHeaderArg -- ^ do not use
11 | SpecialHeaderArg -- ^ do not use
11
12
12instance Show CmdArg where
13instance Show CmdArg where
13− show ExprArg = "<expr>"
14+ show ExprArg = "<expr>"
14− show NameArg = "<name>"
15+ show NameArg = "<name>"
15− show FileArg = "<filename>"
16+ show FileArg = "<filename>"
16− show ModuleArg = "<module>"
17+ show ModuleArg = "<module>"
17− show OptionArg = "<option>"
18+ show OptionArg = "<option>"
18− show MetaVarArg = "<metavar>"
19+ show MetaVarArg = "<metavar>"
20+ show ColourArg = "<option>"
19− show NoArg = ""
21+ show NoArg = ""
20 show SpecialHeaderArg = "Arguments"
22 show SpecialHeaderArg = "Arguments"
21
23
22help :: [([String], CmdArg, String)]
24help :: [([String], CmdArg, String)]
@@ -46,6 +48,6 @@ help =
46 ([":?",":h",":help"], NoArg, "Display this help text"),
48 ([":?",":h",":help"], NoArg, "Display this help text"),
47 ([":set"], OptionArg, "Set an option (errorcontext, showimplicits)"),
49 ([":set"], OptionArg, "Set an option (errorcontext, showimplicits)"),
48 ([":unset"], OptionArg, "Unset an option"),
50 ([":unset"], OptionArg, "Unset an option"),
49− ([":colour", ":color"], NoArg, "Turn REPL colours on or off; set a specific colour"),
51+ ([":colour", ":color"], ColourArg, "Turn REPL colours on or off; set a specific colour"),
50 ([":q",":quit"], NoArg, "Exit the Idris system")
52 ([":q",":quit"], NoArg, "Exit the Idris system")
51 ]
53 ]