{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Reflex.Dom.Pandoc.SyntaxHighlighting where
import Control.Monad (forM_, msum)
import Data.Text (Text)
import Reflex.Dom.Core
import Reflex.Dom.Pandoc.Util (elPandocAttr)
import qualified Skylighting as S
import Text.Pandoc.Definition (Attr)
import Prelude hiding (lines)
elCodeHighlighted ::
forall t m.
DomBuilder t m =>
Attr ->
Text ->
m ()
elCodeHighlighted :: Attr -> Text -> m ()
elCodeHighlighted attr :: Attr
attr@(Text
_, [Text]
langClasses, [(Text, Text)]
_) Text
x = do
case [Text] -> Text -> Maybe [SourceLine]
forall (t :: * -> *).
(Foldable t, Functor t) =>
t Text -> Text -> Maybe [SourceLine]
tokenizeForOneOfLang [Text]
langClasses Text
x of
Maybe [SourceLine]
Nothing -> do
Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
divClass Text
"pandoc-code nosyntax" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"pre" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> Attr -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Attr -> m a -> m a
elPandocAttr Text
"code" Attr
attr (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
x
Just [SourceLine]
lines ->
Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
divClass Text
"pandoc-code highlighted" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"pre" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> Attr -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Attr -> m a -> m a
elPandocAttr Text
"code" Attr
attr (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[SourceLine] -> (SourceLine -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SourceLine]
lines ((SourceLine -> m ()) -> m ()) -> (SourceLine -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SourceLine
line -> do
SourceLine -> (Token -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ SourceLine
line ((Token -> m ()) -> m ()) -> (Token -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(TokenType
tokType, Text
tok) ->
Text -> Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Text -> m a -> m a
elClass Text
"span" (TokenType -> Text
tokenClass TokenType
tokType) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
tok
Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"\n"
where
tokenizeForOneOfLang :: t Text -> Text -> Maybe [SourceLine]
tokenizeForOneOfLang t Text
langs Text
s = do
Syntax
syntax <- t (Maybe Syntax) -> Maybe Syntax
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Text -> Maybe Syntax) -> t Text -> t (Maybe Syntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> SyntaxMap -> Maybe Syntax
`S.lookupSyntax` SyntaxMap
S.defaultSyntaxMap) t Text
langs)
case TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
S.tokenize TokenizerConfig
tokenizerConfig Syntax
syntax Text
s of
Left String
_ -> Maybe [SourceLine]
forall a. Maybe a
Nothing
Right [SourceLine]
lines -> [SourceLine] -> Maybe [SourceLine]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SourceLine]
lines
tokenizerConfig :: TokenizerConfig
tokenizerConfig =
TokenizerConfig :: SyntaxMap -> Bool -> TokenizerConfig
S.TokenizerConfig
{ syntaxMap :: SyntaxMap
S.syntaxMap = SyntaxMap
S.defaultSyntaxMap,
traceOutput :: Bool
S.traceOutput = Bool
False
}
tokenClass :: S.TokenType -> Text
tokenClass :: TokenType -> Text
tokenClass = \case
TokenType
S.KeywordTok -> Text
"kw"
TokenType
S.DataTypeTok -> Text
"dt"
TokenType
S.DecValTok -> Text
"dv"
TokenType
S.BaseNTok -> Text
"bn"
TokenType
S.FloatTok -> Text
"fl"
TokenType
S.CharTok -> Text
"ch"
TokenType
S.StringTok -> Text
"st"
TokenType
S.CommentTok -> Text
"co"
TokenType
S.OtherTok -> Text
"ot"
TokenType
S.AlertTok -> Text
"al"
TokenType
S.FunctionTok -> Text
"fu"
TokenType
S.RegionMarkerTok -> Text
"re"
TokenType
S.ErrorTok -> Text
"er"
TokenType
S.ConstantTok -> Text
"cn"
TokenType
S.SpecialCharTok -> Text
"sc"
TokenType
S.VerbatimStringTok -> Text
"vs"
TokenType
S.SpecialStringTok -> Text
"ss"
TokenType
S.ImportTok -> Text
"im"
TokenType
S.DocumentationTok -> Text
"do"
TokenType
S.AnnotationTok -> Text
"an"
TokenType
S.CommentVarTok -> Text
"cv"
TokenType
S.VariableTok -> Text
"va"
TokenType
S.ControlFlowTok -> Text
"cf"
TokenType
S.OperatorTok -> Text
"op"
TokenType
S.BuiltInTok -> Text
"bu"
TokenType
S.ExtensionTok -> Text
"ex"
TokenType
S.PreprocessorTok -> Text
"pp"
TokenType
S.AttributeTok -> Text
"at"
TokenType
S.InformationTok -> Text
"in"
TokenType
S.WarningTok -> Text
"wa"
TokenType
S.NormalTok -> Text
""