module Idris.Colours (
IdrisColour(..)
, ColourTheme(..)
, defaultTheme
, colouriseKwd, colouriseBound, colouriseImplicit, colourisePostulate
, colouriseType, colouriseFun, colouriseData, colouriseKeyword
, colourisePrompt, colourise, ColourType(..), hStartColourise, hEndColourise
) where
import GHC.Generics (Generic)
import System.Console.ANSI
import System.IO (Handle)
data IdrisColour = IdrisColour { colour :: Maybe Color
, vivid :: Bool
, underline :: Bool
, bold :: Bool
, italic :: Bool
}
deriving (Eq, Show)
mkColour :: Color -> IdrisColour
mkColour c = IdrisColour (Just c) True False False False
data ColourTheme = ColourTheme { keywordColour :: IdrisColour
, boundVarColour :: IdrisColour
, implicitColour :: IdrisColour
, functionColour :: IdrisColour
, typeColour :: IdrisColour
, dataColour :: IdrisColour
, promptColour :: IdrisColour
, postulateColour :: IdrisColour
}
deriving (Eq, Show, Generic)
defaultTheme :: ColourTheme
defaultTheme = ColourTheme { keywordColour = IdrisColour Nothing True False True False
, boundVarColour = mkColour Magenta
, implicitColour = IdrisColour (Just Magenta) True True False False
, functionColour = mkColour Green
, typeColour = mkColour Blue
, dataColour = mkColour Red
, promptColour = IdrisColour Nothing True False True False
, postulateColour = IdrisColour (Just Green) True False True False
}
mkSGR :: IdrisColour -> [SGR]
mkSGR (IdrisColour c v u b i) =
fg c ++
[SetUnderlining SingleUnderline | u] ++
[SetConsoleIntensity BoldIntensity | b] ++
[SetItalicized True | i]
where
fg Nothing = []
fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
colourise :: IdrisColour -> String -> String
colourise c str = setSGRCode (mkSGR c) ++ str ++ setSGRCode [Reset]
hStartColourise :: Handle -> IdrisColour -> IO ()
hStartColourise h c = hSetSGR h (mkSGR c)
hEndColourise :: Handle -> IdrisColour -> IO ()
hEndColourise h _ = hSetSGR h [Reset]
colouriseWithSTX :: IdrisColour -> String -> String
colouriseWithSTX (IdrisColour c v u b i) str = setSGRCode sgr ++ "\STX" ++ str ++ setSGRCode [Reset] ++ "\STX"
where sgr = fg c ++
[SetUnderlining SingleUnderline | u] ++
[SetConsoleIntensity BoldIntensity | b] ++
[SetItalicized True | i]
fg Nothing = []
fg (Just c) = [SetColor Foreground (if v then Vivid else Dull) c]
colouriseKwd :: ColourTheme -> String -> String
colouriseKwd t = colourise (keywordColour t)
colouriseBound :: ColourTheme -> String -> String
colouriseBound t = colourise (boundVarColour t)
colouriseImplicit :: ColourTheme -> String -> String
colouriseImplicit t = colourise (implicitColour t)
colouriseFun :: ColourTheme -> String -> String
colouriseFun t = colourise (functionColour t)
colouriseType :: ColourTheme -> String -> String
colouriseType t = colourise (typeColour t)
colouriseData :: ColourTheme -> String -> String
colouriseData t = colourise (dataColour t)
colourisePrompt :: ColourTheme -> String -> String
colourisePrompt t = colouriseWithSTX (promptColour t)
colouriseKeyword :: ColourTheme -> String -> String
colouriseKeyword t = colourise (keywordColour t)
colourisePostulate :: ColourTheme -> String -> String
colourisePostulate t = colourise (postulateColour t)
data ColourType = KeywordColour
| BoundVarColour
| ImplicitColour
| FunctionColour
| TypeColour
| DataColour
| PromptColour
| PostulateColour
deriving (Eq, Show, Bounded, Enum)