git.iko.soy/Idris-dev
on de2011f help sign in
Idris-dev/src/Idris/Colours.hs
102 lines 4.4 kB history raw
1module Idris.Colours (
2 IdrisColour(..),
3 ColourTheme(..),
4 defaultTheme,
5 colouriseKwd, colouriseBound, colouriseImplicit, colourisePostulate,
6 colouriseType, colouriseFun, colouriseData, colouriseKeyword,
7 colourisePrompt, colourise, ColourType(..)) where
9import System.Console.ANSI
11data IdrisColour = IdrisColour { colour :: Maybe Color
12 , vivid :: Bool
13 , underline :: Bool
14 , bold :: Bool
15 , italic :: Bool
16 }
17 deriving (Eq, Show)
19mkColour :: Color -> IdrisColour
20mkColour c = IdrisColour (Just c) True False False False
22data ColourTheme = ColourTheme { keywordColour :: IdrisColour
23 , boundVarColour :: IdrisColour
24 , implicitColour :: IdrisColour
25 , functionColour :: IdrisColour
26 , typeColour :: IdrisColour
27 , dataColour :: IdrisColour
28 , promptColour :: IdrisColour
29 , postulateColour :: IdrisColour
30 }
31 deriving (Eq, Show)
33-- | Idris's default console colour theme
34defaultTheme :: ColourTheme
35defaultTheme = ColourTheme { keywordColour = IdrisColour Nothing True False True False
36 , boundVarColour = mkColour Magenta
37 , implicitColour = IdrisColour (Just Magenta) True True False False
38 , functionColour = mkColour Green
39 , typeColour = mkColour Blue
40 , dataColour = mkColour Red
41 , promptColour = IdrisColour Nothing True False True False
42 , postulateColour = IdrisColour (Just Green) True False True False
43 }
45-- | Set the colour of a string using POSIX escape codes
46colourise :: IdrisColour -> String -> String
47colourise (IdrisColour c v u b i) str = setSGRCode sgr ++ str ++ setSGRCode [Reset]
48 where sgr = fg c ++
49 (if u then [SetUnderlining SingleUnderline] else []) ++
50 (if b then [SetConsoleIntensity BoldIntensity] else []) ++
51 (if i then [SetItalicized True] else [])
52 fg Nothing = []
53 fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
55-- | Set the colour of a string using POSIX escape codes, with trailing '\STX' denoting the end
56-- (required by Haskeline in the prompt string)
57colouriseWithSTX :: IdrisColour -> String -> String
58colouriseWithSTX (IdrisColour c v u b i) str = setSGRCode sgr ++ "\STX" ++ str ++ setSGRCode [Reset] ++ "\STX"
59 where sgr = fg c ++
60 (if u then [SetUnderlining SingleUnderline] else []) ++
61 (if b then [SetConsoleIntensity BoldIntensity] else []) ++
62 (if i then [SetItalicized True] else [])
63 fg Nothing = []
64 fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
66colouriseKwd :: ColourTheme -> String -> String
67colouriseKwd t = colourise (keywordColour t)
69colouriseBound :: ColourTheme -> String -> String
70colouriseBound t = colourise (boundVarColour t)
72colouriseImplicit :: ColourTheme -> String -> String
73colouriseImplicit t = colourise (implicitColour t)
75colouriseFun :: ColourTheme -> String -> String
76colouriseFun t = colourise (functionColour t)
78colouriseType :: ColourTheme -> String -> String
79colouriseType t = colourise (typeColour t)
81colouriseData :: ColourTheme -> String -> String
82colouriseData t = colourise (dataColour t)
84colourisePrompt :: ColourTheme -> String -> String
85colourisePrompt t = colouriseWithSTX (promptColour t)
87colouriseKeyword :: ColourTheme -> String -> String
88colouriseKeyword t = colourise (keywordColour t)
90colourisePostulate :: ColourTheme -> String -> String
91colourisePostulate t = colourise (postulateColour t)
94data ColourType = KeywordColour
95 | BoundVarColour
96 | ImplicitColour
97 | FunctionColour
98 | TypeColour
99 | DataColour
100 | PromptColour
101 | PostulateColour
102 deriving (Eq, Show, Bounded, Enum)