{-# LANGUAGE OverloadedStrings #-}
-- | This module provides an API for building Brick widgets to display
-- syntax-highlighted text using the Skylighting library.
--
-- To use this module, you'll need to:
--
--  * have some 'Text' you want to syntax-highlight.
--  * know the language in which the 'Text' is expressed.
--  * have a loaded 'SyntaxMap' or 'Syntax' that can be used to format
--    the input text.
--  * have a Skylighting 'Style' you'd like to use to determine the
--    colors, either from the Skylighting package or one of your own.
--
-- To highlight some text in your user interface, use one of
-- the (increasingly finer-grained) highlighting functions
-- 'highlight', 'highlight'', or 'renderRawSource'.
--
-- To actually see pretty colors, you'll need to update your
-- application's 'AttrMap' with name-to-color mappings. Those can be
-- built from a Skylighting 'Style' with 'attrMappingsForStyle' and then
-- appended to your 'attrMap' mapping list.
--
-- The highlighted code widget produced by this module uses
-- 'highlightedCodeBlockAttr' as its base attribute and then uses
-- a specific attribute for each kind of Skylighting token as per
-- 'attrNameForTokenType'.
--
-- See the @programs/Demo.hs@ program in this package for an example of a
-- complete program that uses this module.
module Brick.Widgets.Skylighting
  ( -- * Highlighting functions
    highlight
  , highlightFromMap
  , highlight'
  , renderRawSource

  -- * Attributes
  , 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(..))

-- Hightlight the specified text by attempting to locate a syntax
-- highlighter for the specified language in a syntax map. If the
-- specified language does not have a corresponding Skylighting parser
-- or if a parser is found but fails to parse the input, the text is
-- rendered as-is and tab characters are converted to eight spaces.
highlightFromMap :: Sky.SyntaxMap
                 -- ^ The syntax map to use to locate a syntax
                 -- definition.
                 -> T.Text
                 -- ^ The Skylighting name of the language in which the
                 -- input text is written.
                 -> T.Text
                 -- ^ The text to be syntax-highlighted.
                 -> 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 the specified text using the provided syntax definition.
highlight :: Sky.Syntax
          -- ^ The syntax to use to parse the input text.
          -> T.Text
          -- ^ The text to be syntax-highlighted.
          -> 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

-- | If you already have a 'Syntax' handy and want to have control over
-- how each 'Text' token in the Skylighting AST gets converted to a
-- 'Widget', this provides more control than 'highlight', which just
-- defaults the text widget constructor to 'txt'. If the specified
-- parser fails to parse the input, the text is displayed as-is and tab
-- characters are converted to eight spaces.
highlight' :: (T.Text -> Widget n)
           -- ^ The token widget constructor.
           -> Sky.Syntax
           -- ^ The syntax to use to parse the input text.
           -> T.Text
           -- ^ The text to be syntax-highlighted.
           -> 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
" ")

-- | If you have already parsed your input text into Skylighting tokens,
-- this function is the best one to use.
renderRawSource :: (T.Text -> Widget n)
                -- ^ The token widget constructor.
                -> [Sky.SourceLine]
                -- ^ The parsed input.
                -> 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

-- | The base attribute name for all syntax-highlighted renderings.
highlightedCodeBlockAttr :: AttrName
highlightedCodeBlockAttr :: AttrName
highlightedCodeBlockAttr = String -> AttrName
attrName String
"highlightedCodeBlock"

-- | The constructor for attribute names for each 'TokenType' in
-- Skylighting.
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"

-- | Given a Skylighting 'Style', build an equivalent list of
-- Brick-compatible 'AttrMap' entries. This will usually return
-- 256-color entries.
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)