{-# LANGUAGE DeriveGeneric #-}
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 { IdrisColour -> Maybe Color
colour :: Maybe Color
, IdrisColour -> Bool
vivid :: Bool
, IdrisColour -> Bool
underline :: Bool
, IdrisColour -> Bool
bold :: Bool
, IdrisColour -> Bool
italic :: Bool
}
deriving (IdrisColour -> IdrisColour -> Bool
(IdrisColour -> IdrisColour -> Bool)
-> (IdrisColour -> IdrisColour -> Bool) -> Eq IdrisColour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdrisColour -> IdrisColour -> Bool
== :: IdrisColour -> IdrisColour -> Bool
$c/= :: IdrisColour -> IdrisColour -> Bool
/= :: IdrisColour -> IdrisColour -> Bool
Eq, Int -> IdrisColour -> ShowS
[IdrisColour] -> ShowS
IdrisColour -> String
(Int -> IdrisColour -> ShowS)
-> (IdrisColour -> String)
-> ([IdrisColour] -> ShowS)
-> Show IdrisColour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdrisColour -> ShowS
showsPrec :: Int -> IdrisColour -> ShowS
$cshow :: IdrisColour -> String
show :: IdrisColour -> String
$cshowList :: [IdrisColour] -> ShowS
showList :: [IdrisColour] -> ShowS
Show)
mkColour :: Color -> IdrisColour
mkColour :: Color -> IdrisColour
mkColour Color
c = Maybe Color -> Bool -> Bool -> Bool -> Bool -> IdrisColour
IdrisColour (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c) Bool
True Bool
False Bool
False Bool
False
data ColourTheme = ColourTheme { ColourTheme -> IdrisColour
keywordColour :: IdrisColour
, ColourTheme -> IdrisColour
boundVarColour :: IdrisColour
, ColourTheme -> IdrisColour
implicitColour :: IdrisColour
, ColourTheme -> IdrisColour
functionColour :: IdrisColour
, ColourTheme -> IdrisColour
typeColour :: IdrisColour
, ColourTheme -> IdrisColour
dataColour :: IdrisColour
, ColourTheme -> IdrisColour
promptColour :: IdrisColour
, ColourTheme -> IdrisColour
postulateColour :: IdrisColour
}
deriving (ColourTheme -> ColourTheme -> Bool
(ColourTheme -> ColourTheme -> Bool)
-> (ColourTheme -> ColourTheme -> Bool) -> Eq ColourTheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColourTheme -> ColourTheme -> Bool
== :: ColourTheme -> ColourTheme -> Bool
$c/= :: ColourTheme -> ColourTheme -> Bool
/= :: ColourTheme -> ColourTheme -> Bool
Eq, Int -> ColourTheme -> ShowS
[ColourTheme] -> ShowS
ColourTheme -> String
(Int -> ColourTheme -> ShowS)
-> (ColourTheme -> String)
-> ([ColourTheme] -> ShowS)
-> Show ColourTheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColourTheme -> ShowS
showsPrec :: Int -> ColourTheme -> ShowS
$cshow :: ColourTheme -> String
show :: ColourTheme -> String
$cshowList :: [ColourTheme] -> ShowS
showList :: [ColourTheme] -> ShowS
Show, (forall x. ColourTheme -> Rep ColourTheme x)
-> (forall x. Rep ColourTheme x -> ColourTheme)
-> Generic ColourTheme
forall x. Rep ColourTheme x -> ColourTheme
forall x. ColourTheme -> Rep ColourTheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColourTheme -> Rep ColourTheme x
from :: forall x. ColourTheme -> Rep ColourTheme x
$cto :: forall x. Rep ColourTheme x -> ColourTheme
to :: forall x. Rep ColourTheme x -> ColourTheme
Generic)
defaultTheme :: ColourTheme
defaultTheme :: ColourTheme
defaultTheme = ColourTheme { keywordColour :: IdrisColour
keywordColour = Maybe Color -> Bool -> Bool -> Bool -> Bool -> IdrisColour
IdrisColour Maybe Color
forall a. Maybe a
Nothing Bool
True Bool
False Bool
True Bool
False
, boundVarColour :: IdrisColour
boundVarColour = Color -> IdrisColour
mkColour Color
Magenta
, implicitColour :: IdrisColour
implicitColour = Maybe Color -> Bool -> Bool -> Bool -> Bool -> IdrisColour
IdrisColour (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
Magenta) Bool
True Bool
True Bool
False Bool
False
, functionColour :: IdrisColour
functionColour = Color -> IdrisColour
mkColour Color
Green
, typeColour :: IdrisColour
typeColour = Color -> IdrisColour
mkColour Color
Blue
, dataColour :: IdrisColour
dataColour = Color -> IdrisColour
mkColour Color
Red
, promptColour :: IdrisColour
promptColour = Maybe Color -> Bool -> Bool -> Bool -> Bool -> IdrisColour
IdrisColour Maybe Color
forall a. Maybe a
Nothing Bool
True Bool
False Bool
True Bool
False
, postulateColour :: IdrisColour
postulateColour = Maybe Color -> Bool -> Bool -> Bool -> Bool -> IdrisColour
IdrisColour (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
Green) Bool
True Bool
False Bool
True Bool
False
}
mkSGR :: IdrisColour -> [SGR]
mkSGR :: IdrisColour -> [SGR]
mkSGR (IdrisColour Maybe Color
c Bool
v Bool
u Bool
b Bool
i) =
Maybe Color -> [SGR]
fg Maybe Color
c [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[Underlining -> SGR
SetUnderlining Underlining
SingleUnderline | Bool
u] [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity | Bool
b] [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[Bool -> SGR
SetItalicized Bool
True | Bool
i]
where
fg :: Maybe Color -> [SGR]
fg Maybe Color
Nothing = []
fg (Just Color
c) = [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground (if Bool
v then ColorIntensity
Vivid else ColorIntensity
Dull) Color
c]
colourise :: IdrisColour -> String -> String
colourise :: IdrisColour -> ShowS
colourise IdrisColour
c String
str = [SGR] -> String
setSGRCode (IdrisColour -> [SGR]
mkSGR IdrisColour
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode [SGR
Reset]
hStartColourise :: Handle -> IdrisColour -> IO ()
hStartColourise :: Handle -> IdrisColour -> IO ()
hStartColourise Handle
h IdrisColour
c = Handle -> [SGR] -> IO ()
hSetSGR Handle
h (IdrisColour -> [SGR]
mkSGR IdrisColour
c)
hEndColourise :: Handle -> IdrisColour -> IO ()
hEndColourise :: Handle -> IdrisColour -> IO ()
hEndColourise Handle
h IdrisColour
_ = Handle -> [SGR] -> IO ()
hSetSGR Handle
h [SGR
Reset]
colouriseWithSTX :: IdrisColour -> String -> String
colouriseWithSTX :: IdrisColour -> ShowS
colouriseWithSTX (IdrisColour Maybe Color
c Bool
v Bool
u Bool
b Bool
i) String
str = [SGR] -> String
setSGRCode [SGR]
sgr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\STX" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode [SGR
Reset] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\STX"
where sgr :: [SGR]
sgr = Maybe Color -> [SGR]
fg Maybe Color
c [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[Underlining -> SGR
SetUnderlining Underlining
SingleUnderline | Bool
u] [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity | Bool
b] [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++
[Bool -> SGR
SetItalicized Bool
True | Bool
i]
fg :: Maybe Color -> [SGR]
fg Maybe Color
Nothing = []
fg (Just Color
c) = [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground (if Bool
v then ColorIntensity
Vivid else ColorIntensity
Dull) Color
c]
colouriseKwd :: ColourTheme -> String -> String
colouriseKwd :: ColourTheme -> ShowS
colouriseKwd ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
keywordColour ColourTheme
t)
colouriseBound :: ColourTheme -> String -> String
colouriseBound :: ColourTheme -> ShowS
colouriseBound ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
boundVarColour ColourTheme
t)
colouriseImplicit :: ColourTheme -> String -> String
colouriseImplicit :: ColourTheme -> ShowS
colouriseImplicit ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
implicitColour ColourTheme
t)
colouriseFun :: ColourTheme -> String -> String
colouriseFun :: ColourTheme -> ShowS
colouriseFun ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
functionColour ColourTheme
t)
colouriseType :: ColourTheme -> String -> String
colouriseType :: ColourTheme -> ShowS
colouriseType ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
typeColour ColourTheme
t)
colouriseData :: ColourTheme -> String -> String
colouriseData :: ColourTheme -> ShowS
colouriseData ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
dataColour ColourTheme
t)
colourisePrompt :: ColourTheme -> String -> String
colourisePrompt :: ColourTheme -> ShowS
colourisePrompt ColourTheme
t = IdrisColour -> ShowS
colouriseWithSTX (ColourTheme -> IdrisColour
promptColour ColourTheme
t)
colouriseKeyword :: ColourTheme -> String -> String
colouriseKeyword :: ColourTheme -> ShowS
colouriseKeyword ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
keywordColour ColourTheme
t)
colourisePostulate :: ColourTheme -> String -> String
colourisePostulate :: ColourTheme -> ShowS
colourisePostulate ColourTheme
t = IdrisColour -> ShowS
colourise (ColourTheme -> IdrisColour
postulateColour ColourTheme
t)
data ColourType = KeywordColour
| BoundVarColour
| ImplicitColour
| FunctionColour
| TypeColour
| DataColour
| PromptColour
| PostulateColour
deriving (ColourType -> ColourType -> Bool
(ColourType -> ColourType -> Bool)
-> (ColourType -> ColourType -> Bool) -> Eq ColourType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColourType -> ColourType -> Bool
== :: ColourType -> ColourType -> Bool
$c/= :: ColourType -> ColourType -> Bool
/= :: ColourType -> ColourType -> Bool
Eq, Int -> ColourType -> ShowS
[ColourType] -> ShowS
ColourType -> String
(Int -> ColourType -> ShowS)
-> (ColourType -> String)
-> ([ColourType] -> ShowS)
-> Show ColourType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColourType -> ShowS
showsPrec :: Int -> ColourType -> ShowS
$cshow :: ColourType -> String
show :: ColourType -> String
$cshowList :: [ColourType] -> ShowS
showList :: [ColourType] -> ShowS
Show, ColourType
ColourType -> ColourType -> Bounded ColourType
forall a. a -> a -> Bounded a
$cminBound :: ColourType
minBound :: ColourType
$cmaxBound :: ColourType
maxBound :: ColourType
Bounded, Int -> ColourType
ColourType -> Int
ColourType -> [ColourType]
ColourType -> ColourType
ColourType -> ColourType -> [ColourType]
ColourType -> ColourType -> ColourType -> [ColourType]
(ColourType -> ColourType)
-> (ColourType -> ColourType)
-> (Int -> ColourType)
-> (ColourType -> Int)
-> (ColourType -> [ColourType])
-> (ColourType -> ColourType -> [ColourType])
-> (ColourType -> ColourType -> [ColourType])
-> (ColourType -> ColourType -> ColourType -> [ColourType])
-> Enum ColourType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColourType -> ColourType
succ :: ColourType -> ColourType
$cpred :: ColourType -> ColourType
pred :: ColourType -> ColourType
$ctoEnum :: Int -> ColourType
toEnum :: Int -> ColourType
$cfromEnum :: ColourType -> Int
fromEnum :: ColourType -> Int
$cenumFrom :: ColourType -> [ColourType]
enumFrom :: ColourType -> [ColourType]
$cenumFromThen :: ColourType -> ColourType -> [ColourType]
enumFromThen :: ColourType -> ColourType -> [ColourType]
$cenumFromTo :: ColourType -> ColourType -> [ColourType]
enumFromTo :: ColourType -> ColourType -> [ColourType]
$cenumFromThenTo :: ColourType -> ColourType -> ColourType -> [ColourType]
enumFromThenTo :: ColourType -> ColourType -> ColourType -> [ColourType]
Enum)