git.iko.soy/Idris-dev
on master help sign in
Merge pull request #640 from david-christiansen/color-theme-default-option
27a6ec7Edwin Brady
src/Idris/Colours.hs+8−6
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ module Idris.Colours (
9
9
10import System.Console.ANSI
10import System.Console.ANSI
11
11
12−data IdrisColour = IdrisColour { colour :: Color
12+data IdrisColour = IdrisColour { colour :: Maybe Color
13 , vivid :: Bool
13 , vivid :: Bool
14 , underline :: Bool
14 , underline :: Bool
15 , bold :: Bool
15 , bold :: Bool
@@ -18,7 +18,7 @@ data IdrisColour = IdrisColour { colour :: Color
18 deriving (Eq, Show)
18 deriving (Eq, Show)
19
19
20mkColour :: Color -> IdrisColour
20mkColour :: Color -> IdrisColour
21−mkColour c = IdrisColour c True False False False
21+mkColour c = IdrisColour (Just c) True False False False
22
22
23data ColourTheme = ColourTheme { keywordColour :: IdrisColour
23data ColourTheme = ColourTheme { keywordColour :: IdrisColour
24 , boundVarColour :: IdrisColour
24 , boundVarColour :: IdrisColour
@@ -31,22 +31,24 @@ data ColourTheme = ColourTheme { keywordColour :: IdrisColour
31 deriving (Eq, Show)
31 deriving (Eq, Show)
32
32
33defaultTheme :: ColourTheme
33defaultTheme :: ColourTheme
34−defaultTheme = ColourTheme { keywordColour = IdrisColour Black True True True False
34+defaultTheme = ColourTheme { keywordColour = IdrisColour Nothing True True True False
35 , boundVarColour = mkColour Magenta
35 , boundVarColour = mkColour Magenta
36− , implicitColour = IdrisColour Magenta True True False False
36+ , implicitColour = IdrisColour (Just Magenta) True True False False
37 , functionColour = mkColour Green
37 , functionColour = mkColour Green
38 , typeColour = mkColour Blue
38 , typeColour = mkColour Blue
39 , dataColour = mkColour Red
39 , dataColour = mkColour Red
40− , promptColour = IdrisColour Black True False True False
40+ , promptColour = IdrisColour Nothing True False True False
41 }
41 }
42
42
43-- Set the colour of a string using POSIX escape codes
43-- Set the colour of a string using POSIX escape codes
44colourise :: IdrisColour -> String -> String
44colourise :: IdrisColour -> String -> String
45colourise (IdrisColour c v u b i) str = setSGRCode sgr ++ str ++ setSGRCode [Reset]
45colourise (IdrisColour c v u b i) str = setSGRCode sgr ++ str ++ setSGRCode [Reset]
46− where sgr = [SetColor Foreground (if v then Vivid else Dull) c] ++
46+ where sgr = fg c ++
47 (if u then [SetUnderlining SingleUnderline] else []) ++
47 (if u then [SetUnderlining SingleUnderline] else []) ++
48 (if b then [SetConsoleIntensity BoldIntensity] else []) ++
48 (if b then [SetConsoleIntensity BoldIntensity] else []) ++
49 (if i then [SetItalicized True] else [])
49 (if i then [SetItalicized True] else [])
50+ fg Nothing = []
51+ fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
50
52
51colouriseKwd :: ColourTheme -> String -> String
53colouriseKwd :: ColourTheme -> String -> String
52colouriseKwd t = colourise (keywordColour t)
54colouriseKwd t = colourise (keywordColour t)
src/Idris/REPLParser.hs+12−11
@@ -106,18 +106,19 @@ pOption = do discard (P.symbol "errorcontext"); return ErrContext
106 <|> do discard (P.symbol "showimplicits"); return ShowImpl
106 <|> do discard (P.symbol "showimplicits"); return ShowImpl
107
107
108
108
109−colours :: [(String, Color)]
109+colours :: [(String, Maybe Color)]
110−colours = [ ("black", Black)
110+colours = [ ("black", Just Black)
111− , ("red", Red)
111+ , ("red", Just Red)
112− , ("green", Green)
112+ , ("green", Just Green)
113− , ("yellow", Yellow)
113+ , ("yellow", Just Yellow)
114− , ("blue", Blue)
114+ , ("blue", Just Blue)
115− , ("magenta", Magenta)
115+ , ("magenta", Just Magenta)
116− , ("cyan", Cyan)
116+ , ("cyan", Just Cyan)
117− , ("white", White)
117+ , ("white", Just White)
118+ , ("default", Nothing)
118 ]
119 ]
119
120
120−pColour :: P.IdrisParser Color
121+pColour :: P.IdrisParser (Maybe Color)
121pColour = doColour colours
122pColour = doColour colours
122 where doColour [] = fail "Unknown colour"
123 where doColour [] = fail "Unknown colour"
123 doColour ((s, c):cs) = (try (P.symbol s) >> return c) <|> doColour cs
124 doColour ((s, c):cs) = (try (P.symbol s) >> return c) <|> doColour cs
@@ -155,7 +156,7 @@ pColourType = doColourType colourTypes
155
156
156pSetColourCmd :: P.IdrisParser Command
157pSetColourCmd :: P.IdrisParser Command
157pSetColourCmd = (do c <- pColourType
158pSetColourCmd = (do c <- pColourType
158− let defaultColour = IdrisColour Black True False False False
159+ let defaultColour = IdrisColour Nothing True False False False
159 opts <- sepBy pColourMod (P.whiteSpace)
160 opts <- sepBy pColourMod (P.whiteSpace)
160 let colour = foldr ($) defaultColour $ reverse opts
161 let colour = foldr ($) defaultColour $ reverse opts
161 return $ SetColour c colour)
162 return $ SetColour c colour)