git.iko.soy/Idris-dev
on aeb032a help sign in
Idris-dev/src/Idris/Colours.hs
126 lines 4.9 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-|
3Module : Idris.Colours
4Description : Support for colours within Idris.
5Copyright :
6License : BSD3
7Maintainer : The Idris Community.
8-}
9module Idris.Colours (
10 IdrisColour(..)
11 , ColourTheme(..)
12 , defaultTheme
13 , colouriseKwd, colouriseBound, colouriseImplicit, colourisePostulate
14 , colouriseType, colouriseFun, colouriseData, colouriseKeyword
15 , colourisePrompt, colourise, ColourType(..), hStartColourise, hEndColourise
16 ) where
18import GHC.Generics (Generic)
19import System.Console.ANSI
20import System.IO (Handle)
22data IdrisColour = IdrisColour { colour :: Maybe Color
23 , vivid :: Bool
24 , underline :: Bool
25 , bold :: Bool
26 , italic :: Bool
27 }
28 deriving (Eq, Show)
30mkColour :: Color -> IdrisColour
31mkColour c = IdrisColour (Just c) True False False False
33data ColourTheme = ColourTheme { keywordColour :: IdrisColour
34 , boundVarColour :: IdrisColour
35 , implicitColour :: IdrisColour
36 , functionColour :: IdrisColour
37 , typeColour :: IdrisColour
38 , dataColour :: IdrisColour
39 , promptColour :: IdrisColour
40 , postulateColour :: IdrisColour
41 }
42 deriving (Eq, Show, Generic)
44-- | Idris's default console colour theme
45defaultTheme :: ColourTheme
46defaultTheme = ColourTheme { keywordColour = IdrisColour Nothing True False True False
47 , boundVarColour = mkColour Magenta
48 , implicitColour = IdrisColour (Just Magenta) True True False False
49 , functionColour = mkColour Green
50 , typeColour = mkColour Blue
51 , dataColour = mkColour Red
52 , promptColour = IdrisColour Nothing True False True False
53 , postulateColour = IdrisColour (Just Green) True False True False
54 }
56-- | Compute the ANSI colours corresponding to an Idris colour
57mkSGR :: IdrisColour -> [SGR]
58mkSGR (IdrisColour c v u b i) =
59 fg c ++
60 [SetUnderlining SingleUnderline | u] ++
61 [SetConsoleIntensity BoldIntensity | b] ++
62 [SetItalicized True | i]
63 where
64 fg Nothing = []
65 fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
67-- | Set the colour of a string using POSIX escape codes
68colourise :: IdrisColour -> String -> String
69colourise c str = setSGRCode (mkSGR c) ++ str ++ setSGRCode [Reset]
71-- | Start a colour on a handle, to support colour output on Windows
72hStartColourise :: Handle -> IdrisColour -> IO ()
73hStartColourise h c = hSetSGR h (mkSGR c)
75-- | End a colour region on a handle
76hEndColourise :: Handle -> IdrisColour -> IO ()
77hEndColourise h _ = hSetSGR h [Reset]
79-- | Set the colour of a string using POSIX escape codes, with trailing '\STX' denoting the end
80-- (required by Haskeline in the prompt string)
81colouriseWithSTX :: IdrisColour -> String -> String
82colouriseWithSTX (IdrisColour c v u b i) str = setSGRCode sgr ++ "\STX" ++ str ++ setSGRCode [Reset] ++ "\STX"
83 where sgr = fg c ++
84 [SetUnderlining SingleUnderline | u] ++
85 [SetConsoleIntensity BoldIntensity | b] ++
86 [SetItalicized True | i]
87 fg Nothing = []
88 fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
90colouriseKwd :: ColourTheme -> String -> String
91colouriseKwd t = colourise (keywordColour t)
93colouriseBound :: ColourTheme -> String -> String
94colouriseBound t = colourise (boundVarColour t)
96colouriseImplicit :: ColourTheme -> String -> String
97colouriseImplicit t = colourise (implicitColour t)
99colouriseFun :: ColourTheme -> String -> String
100colouriseFun t = colourise (functionColour t)
102colouriseType :: ColourTheme -> String -> String
103colouriseType t = colourise (typeColour t)
105colouriseData :: ColourTheme -> String -> String
106colouriseData t = colourise (dataColour t)
108colourisePrompt :: ColourTheme -> String -> String
109colourisePrompt t = colouriseWithSTX (promptColour t)
111colouriseKeyword :: ColourTheme -> String -> String
112colouriseKeyword t = colourise (keywordColour t)
114colourisePostulate :: ColourTheme -> String -> String
115colourisePostulate t = colourise (postulateColour t)
118data ColourType = KeywordColour
119 | BoundVarColour
120 | ImplicitColour
121 | FunctionColour
122 | TypeColour
123 | DataColour
124 | PromptColour
125 | PostulateColour
126 deriving (Eq, Show, Bounded, Enum)