{-# LANGUAGE OverloadedStrings #-}
module Brick.Widgets.Skylighting
(
highlight
, highlightFromMap
, highlight'
, renderRawSource
, attrMappingsForStyle
, attrNameForTokenType
, highlightedCodeBlockAttr
)
where
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Graphics.Vty as V
import Brick
import qualified Skylighting.Core as Sky
import Skylighting.Types (TokenType(..))
highlightFromMap :: Sky.SyntaxMap
-> T.Text
-> T.Text
-> Widget n
highlightFromMap :: SyntaxMap -> Text -> Text -> Widget n
highlightFromMap SyntaxMap
m Text
name Text
input =
case SyntaxMap -> Text -> Maybe Syntax
Sky.syntaxByName SyntaxMap
m Text
name of
Maybe Syntax
Nothing -> Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text
expandTabs Text
input
Just Syntax
s -> Syntax -> Text -> Widget n
forall n. Syntax -> Text -> Widget n
highlight Syntax
s Text
input
highlight :: Sky.Syntax
-> T.Text
-> Widget n
highlight :: Syntax -> Text -> Widget n
highlight = (Text -> Widget n) -> Syntax -> Text -> Widget n
forall n. (Text -> Widget n) -> Syntax -> Text -> Widget n
highlight' Text -> Widget n
forall n. Text -> Widget n
txt
highlight' :: (T.Text -> Widget n)
-> Sky.Syntax
-> T.Text
-> Widget n
highlight' :: (Text -> Widget n) -> Syntax -> Text -> Widget n
highlight' Text -> Widget n
renderToken Syntax
syntax Text
tx =
let cfg :: TokenizerConfig
cfg = SyntaxMap -> Bool -> TokenizerConfig
Sky.TokenizerConfig ([(Text, Syntax)] -> SyntaxMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Syntax -> Text
Sky.sName Syntax
syntax, Syntax
syntax)]) Bool
False
expanded :: Text
expanded = Text -> Text
expandTabs Text
tx
result :: Either String [SourceLine]
result = TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
Sky.tokenize TokenizerConfig
cfg Syntax
syntax Text
tx
in case Either String [SourceLine]
result of
Left String
_ -> Text -> Widget n
forall n. Text -> Widget n
txt Text
expanded
Right [SourceLine]
tokLines -> (Text -> Widget n) -> [SourceLine] -> Widget n
forall n. (Text -> Widget n) -> [SourceLine] -> Widget n
renderRawSource Text -> Widget n
renderToken [SourceLine]
tokLines
expandTabs :: T.Text -> T.Text
expandTabs :: Text -> Text
expandTabs = Text -> Text -> Text -> Text
T.replace Text
"\t" (Int -> Text -> Text
T.replicate Int
8 Text
" ")
renderRawSource :: (T.Text -> Widget n)
-> [Sky.SourceLine]
-> Widget n
renderRawSource :: (Text -> Widget n) -> [SourceLine] -> Widget n
renderRawSource Text -> Widget n
renderToken [SourceLine]
ls =
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
highlightedCodeBlockAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Text -> Widget n) -> SourceLine -> Widget n
forall n. (Text -> Widget n) -> SourceLine -> Widget n
renderTokenLine Text -> Widget n
renderToken (SourceLine -> Widget n) -> [SourceLine] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceLine]
ls
renderTokenLine :: (T.Text -> Widget n) -> Sky.SourceLine -> Widget n
renderTokenLine :: (Text -> Widget n) -> SourceLine -> Widget n
renderTokenLine Text -> Widget n
_ [] = String -> Widget n
forall n. String -> Widget n
str String
" "
renderTokenLine Text -> Widget n
renderToken SourceLine
toks =
let renderSingle :: (TokenType, Text) -> Widget n
renderSingle (TokenType
ty, Text
tx) = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr (TokenType -> AttrName
attrNameForTokenType TokenType
ty) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
renderToken Text
tx
in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (TokenType, Text) -> Widget n
renderSingle ((TokenType, Text) -> Widget n) -> SourceLine -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceLine
toks
highlightedCodeBlockAttr :: AttrName
highlightedCodeBlockAttr :: AttrName
highlightedCodeBlockAttr = String -> AttrName
attrName String
"highlightedCodeBlock"
attrNameForTokenType :: TokenType -> AttrName
attrNameForTokenType :: TokenType -> AttrName
attrNameForTokenType TokenType
ty = AttrName
highlightedCodeBlockAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
s
where
s :: String
s = case TokenType
ty of
TokenType
KeywordTok -> String
"keyword"
TokenType
DataTypeTok -> String
"dataType"
TokenType
DecValTok -> String
"declaration"
TokenType
BaseNTok -> String
"baseN"
TokenType
FloatTok -> String
"float"
TokenType
ConstantTok -> String
"constant"
TokenType
CharTok -> String
"char"
TokenType
SpecialCharTok -> String
"specialChar"
TokenType
StringTok -> String
"string"
TokenType
VerbatimStringTok -> String
"verbatimString"
TokenType
SpecialStringTok -> String
"specialString"
TokenType
ImportTok -> String
"import"
TokenType
CommentTok -> String
"comment"
TokenType
DocumentationTok -> String
"documentation"
TokenType
AnnotationTok -> String
"annotation"
TokenType
CommentVarTok -> String
"comment"
TokenType
OtherTok -> String
"other"
TokenType
FunctionTok -> String
"function"
TokenType
VariableTok -> String
"variable"
TokenType
ControlFlowTok -> String
"controlFlow"
TokenType
OperatorTok -> String
"operator"
TokenType
BuiltInTok -> String
"builtIn"
TokenType
ExtensionTok -> String
"extension"
TokenType
PreprocessorTok -> String
"preprocessor"
TokenType
AttributeTok -> String
"attribute"
TokenType
RegionMarkerTok -> String
"regionMarker"
TokenType
InformationTok -> String
"information"
TokenType
WarningTok -> String
"warning"
TokenType
AlertTok -> String
"alert"
TokenType
ErrorTok -> String
"error"
TokenType
NormalTok -> String
"normal"
attrMappingsForStyle :: Sky.Style -> [(AttrName, V.Attr)]
attrMappingsForStyle :: Style -> [(AttrName, Attr)]
attrMappingsForStyle Style
sty =
(AttrName
highlightedCodeBlockAttr, (Maybe Color, Maybe Color) -> Attr
baseAttrFromPair (Style -> Maybe Color
Sky.defaultColor Style
sty, Style -> Maybe Color
Sky.backgroundColor Style
sty)) (AttrName, Attr) -> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. a -> [a] -> [a]
:
((TokenType, TokenStyle) -> (AttrName, Attr)
mkTokenTypeEntry ((TokenType, TokenStyle) -> (AttrName, Attr))
-> [(TokenType, TokenStyle)] -> [(AttrName, Attr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map TokenType TokenStyle -> [(TokenType, TokenStyle)]
forall k a. Map k a -> [(k, a)]
M.toList (Map TokenType TokenStyle -> [(TokenType, TokenStyle)])
-> Map TokenType TokenStyle -> [(TokenType, TokenStyle)]
forall a b. (a -> b) -> a -> b
$ Style -> Map TokenType TokenStyle
Sky.tokenStyles Style
sty))
baseAttrFromPair :: (Maybe Sky.Color, Maybe Sky.Color) -> V.Attr
baseAttrFromPair :: (Maybe Color, Maybe Color) -> Attr
baseAttrFromPair (Maybe Color
mf, Maybe Color
mb) =
case (Maybe Color
mf, Maybe Color
mb) of
(Maybe Color
Nothing, Maybe Color
Nothing) -> Attr
V.defAttr
(Just Color
f, Maybe Color
Nothing) -> Color -> Attr
fg (Color -> Color
tokenColorToVtyColor Color
f)
(Maybe Color
Nothing, Just Color
b) -> Color -> Attr
bg (Color -> Color
tokenColorToVtyColor Color
b)
(Just Color
f, Just Color
b) -> (Color -> Color
tokenColorToVtyColor Color
f) Color -> Color -> Attr
`on`
(Color -> Color
tokenColorToVtyColor Color
b)
tokenColorToVtyColor :: Sky.Color -> V.Color
tokenColorToVtyColor :: Color -> Color
tokenColorToVtyColor (Sky.RGB Word8
r Word8
g Word8
b) = Word8 -> Word8 -> Word8 -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Word8
r Word8
g Word8
b
mkTokenTypeEntry :: (Sky.TokenType, Sky.TokenStyle) -> (AttrName, V.Attr)
mkTokenTypeEntry :: (TokenType, TokenStyle) -> (AttrName, Attr)
mkTokenTypeEntry (TokenType
ty, TokenStyle
tSty) =
let a :: Attr
a = Attr -> Attr
setStyle Attr
baseAttr
baseAttr :: Attr
baseAttr = (Maybe Color, Maybe Color) -> Attr
baseAttrFromPair (TokenStyle -> Maybe Color
Sky.tokenColor TokenStyle
tSty, TokenStyle -> Maybe Color
Sky.tokenBackground TokenStyle
tSty)
setStyle :: Attr -> Attr
setStyle =
if TokenStyle -> Bool
Sky.tokenBold TokenStyle
tSty then (Attr -> Word8 -> Attr) -> Word8 -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Word8 -> Attr
V.withStyle Word8
V.bold else Attr -> Attr
forall a. a -> a
id (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
if TokenStyle -> Bool
Sky.tokenItalic TokenStyle
tSty then (Attr -> Word8 -> Attr) -> Word8 -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Word8 -> Attr
V.withStyle Word8
V.italic else Attr -> Attr
forall a. a -> a
id (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
if TokenStyle -> Bool
Sky.tokenUnderline TokenStyle
tSty then (Attr -> Word8 -> Attr) -> Word8 -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Word8 -> Attr
V.withStyle Word8
V.underline else Attr -> Attr
forall a. a -> a
id
in (TokenType -> AttrName
attrNameForTokenType TokenType
ty, Attr
a)