@@ -7,13 +7,16 @@ import Core.CoreParser (opChars)
77
88import Idris.AbsSyntaxTree
99import Idris.Help
10+import Idris.Colours
1011
1112import Control.Monad.State.Strict
1213
1314import Data.List
1415import Data.Maybe
16+import Data.Char(toLower)
1517
1618import System.Console.Haskeline
19+import System.Console.ANSI (Color)
1720
1821
1922fst3 :: (a, b, c) -> a
@@ -109,6 +112,32 @@ lookupInHelp cmd = lookupInHelp' cmd help
109112 | otherwise = lookupInHelp' cmd xs
110113 lookupInHelp' cmd [] = Nothing
111114
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+
112141-- | Get the completion function for a particular command
113142completeCmd :: String -> CompletionFunc Idris
114143completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookupInHelp cmd
@@ -118,6 +147,7 @@ completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lo
118147 completeArg ModuleArg = noCompletion (prev, next) -- FIXME do later
119148 completeArg ExprArg = completeExpr [] (prev, next)
120149 completeArg MetaVarArg = completeMetaVar (prev, next) -- FIXME only complete one name
150+ completeArg ColourArg = completeColour (prev, next)
121151 completeArg NoArg = noCompletion (prev, next)
122152 completeCmdName = return $ ("", completeWith commands cmd)
123153