{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Patat.Presentation.Display.CodeBlock
( prettyCodeBlock
) where
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Patat.Presentation.Display.Table (themed)
import qualified Patat.PrettyPrint as PP
import Patat.Theme
import Prelude
import qualified Skylighting as Skylighting
highlight :: [T.Text] -> T.Text -> [Skylighting.SourceLine]
highlight :: [Text] -> Text -> [SourceLine]
highlight classes :: [Text]
classes rawCodeBlock :: Text
rawCodeBlock = case (Text -> Maybe Syntax) -> [Text] -> [Syntax]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Syntax
getSyntax [Text]
classes of
[] -> Text -> [SourceLine]
zeroHighlight Text
rawCodeBlock
(syn :: Syntax
syn : _) ->
case TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
Skylighting.tokenize TokenizerConfig
config Syntax
syn Text
rawCodeBlock of
Left _ -> Text -> [SourceLine]
zeroHighlight Text
rawCodeBlock
Right sl :: [SourceLine]
sl -> [SourceLine]
sl
where
getSyntax :: T.Text -> Maybe Skylighting.Syntax
getSyntax :: Text -> Maybe Syntax
getSyntax c :: Text
c = Text -> SyntaxMap -> Maybe Syntax
Skylighting.lookupSyntax Text
c SyntaxMap
syntaxMap
config :: Skylighting.TokenizerConfig
config :: TokenizerConfig
config = TokenizerConfig :: SyntaxMap -> Bool -> TokenizerConfig
Skylighting.TokenizerConfig
{ syntaxMap :: SyntaxMap
Skylighting.syntaxMap = SyntaxMap
syntaxMap
, traceOutput :: Bool
Skylighting.traceOutput = Bool
False
}
syntaxMap :: Skylighting.SyntaxMap
syntaxMap :: SyntaxMap
syntaxMap = SyntaxMap
Skylighting.defaultSyntaxMap
zeroHighlight :: T.Text -> [Skylighting.SourceLine]
zeroHighlight :: Text -> [SourceLine]
zeroHighlight txt :: Text
txt =
[[(TokenType
Skylighting.NormalTok, Text
line)] | Text
line <- Text -> [Text]
T.lines Text
txt]
prettyCodeBlock :: Theme -> [T.Text] -> T.Text -> PP.Doc
prettyCodeBlock :: Theme -> [Text] -> Text -> Doc
prettyCodeBlock theme :: Theme
theme@Theme {..} classes :: [Text]
classes rawCodeBlock :: Text
rawCodeBlock =
[Doc] -> Doc
PP.vcat ((SourceLine -> Doc) -> [SourceLine] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Doc
blockified [SourceLine]
sourceLines) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
PP.hardline
where
sourceLines :: [Skylighting.SourceLine]
sourceLines :: [SourceLine]
sourceLines =
[[]] [SourceLine] -> [SourceLine] -> [SourceLine]
forall a. [a] -> [a] -> [a]
++ [Text] -> Text -> [SourceLine]
highlight [Text]
classes Text
rawCodeBlock [SourceLine] -> [SourceLine] -> [SourceLine]
forall a. [a] -> [a] -> [a]
++ [[]]
prettySourceLine :: Skylighting.SourceLine -> PP.Doc
prettySourceLine :: SourceLine -> Doc
prettySourceLine = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> (SourceLine -> [Doc]) -> SourceLine -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Doc) -> SourceLine -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc
prettyToken
prettyToken :: Skylighting.Token -> PP.Doc
prettyToken :: Token -> Doc
prettyToken (tokenType :: TokenType
tokenType, str :: Text
str) =
Maybe Style -> Doc -> Doc
themed (Theme -> TokenType -> Maybe Style
syntaxHighlight Theme
theme TokenType
tokenType) (String -> Doc
PP.string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str)
sourceLineLength :: Skylighting.SourceLine -> Int
sourceLineLength :: SourceLine -> Int
sourceLineLength line :: SourceLine
line = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Text -> Int
T.length Text
str | (_, str :: Text
str) <- SourceLine
line]
blockWidth :: Int
blockWidth :: Int
blockWidth = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 ((SourceLine -> Int) -> [SourceLine] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Int
sourceLineLength [SourceLine]
sourceLines)
blockified :: Skylighting.SourceLine -> PP.Doc
blockified :: SourceLine -> Doc
blockified line :: SourceLine
line =
let len :: Int
len = SourceLine -> Int
sourceLineLength SourceLine
line
indent :: Trimmable Doc
indent = Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable " " in
Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
indent Trimmable Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Maybe Style -> Doc -> Doc
themed Maybe Style
themeCodeBlock (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
SourceLine -> Doc
prettySourceLine SourceLine
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
String -> Doc
PP.string (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
blockWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) ' ') Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> " "