{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Skylighting.Format.Typst (
formatTypstInline
, formatTypstBlock
, styleToTypst
) where
import Control.Monad (mplus)
import Data.List (sort)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Skylighting.Types
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
formatTypstInline :: FormatOptions -> [SourceLine] -> Text
formatTypstInline :: FormatOptions -> [SourceLine] -> Text
formatTypstInline FormatOptions
_opts = Text -> [Text] -> Text
Text.intercalate Text
newline ([Text] -> Text)
-> ([SourceLine] -> [Text]) -> [SourceLine] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> Text) -> [SourceLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Text
sourceLineToTypst
newline :: Text
newline :: Text
newline = Text
"#EndLine()\n"
sourceLineToTypst :: SourceLine -> Text
sourceLineToTypst :: SourceLine -> Text
sourceLineToTypst = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (SourceLine -> [Text]) -> SourceLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Text) -> SourceLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Text
tokenToTypst
tokenToTypst :: Token -> Text
tokenToTypst :: Token -> Text
tokenToTypst (TokenType
toktype, Text
txt) =
Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TokenType -> String
forall a. Show a => a -> String
show TokenType
toktype) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
doubleQuoted Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
");"
doubleQuoted :: Text -> Text
doubleQuoted :: Text -> Text
doubleQuoted Text
t = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escape Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
where
escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
escapeChar
escapeChar :: Char -> Text
escapeChar Char
'\\' = Text
"\\\\"
escapeChar Char
'"' = Text
"\\\""
escapeChar Char
c = Char -> Text
Text.singleton Char
c
formatTypstBlock :: FormatOptions -> [SourceLine] -> Text
formatTypstBlock :: FormatOptions -> [SourceLine] -> Text
formatTypstBlock FormatOptions
opts [SourceLine]
ls =
Text
"#Skylighting(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if FormatOptions -> Bool
numberLines FormatOptions
opts
then Text
"number: true, start: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (FormatOptions -> Int
startNumber FormatOptions
opts)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", "
else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
Text.intercalate Text
"\n" ((SourceLine -> Text) -> [SourceLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\SourceLine
ln -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FormatOptions -> [SourceLine] -> Text
formatTypstInline FormatOptions
opts [SourceLine
ln] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"],") [SourceLine]
ls)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"));"
styleToTypst :: Style -> Text
styleToTypst :: Style -> Text
styleToTypst Style
f =
[Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[ Text
"/* Function definitions for syntax highlighting generated by skylighting: */"
, Text
"#let EndLine() = raw(\"\\n\")"
, Text
"#let Skylighting(fill: none, number: false, start: 1, sourcelines) = {"
, Text
" let blocks = []"
, Text
" let lnum = start - 1"
, Text
" let bgcolor = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" Color -> Text
toTypstColor (Style -> Maybe Color
backgroundColor Style
f)
, Text
" for ln in sourcelines {"
, Text
" if number {"
, Text
" lnum = lnum + 1"
, Text
" blocks = blocks + box(width: if start + sourcelines.len() > 999 { 30pt } else { 24pt }, text(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lineNumberFill Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[ #lnum ]))"
, Text
" }"
, Text
" blocks = blocks + ln + EndLine()"
, Text
" }"
, Text
" block(fill: bgcolor, blocks)"
, Text
"}"
] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
[Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ((TokenType -> Text) -> [TokenType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef (Style -> Maybe Color
defaultColor Style
f) (Map TokenType TokenStyle -> [(TokenType, TokenStyle)]
forall k a. Map k a -> [(k, a)]
Map.toList (Style -> Map TokenType TokenStyle
tokenStyles Style
f)))
(TokenType -> TokenType -> [TokenType]
forall a. Enum a => a -> a -> [a]
enumFromTo TokenType
KeywordTok TokenType
NormalTok))
where
toTypstColor :: Color -> Text
toTypstColor Color
c = Text
"rgb(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (String -> String
forall a. Show a => a -> String
show (Color -> String
forall a. FromColor a => Color -> a
fromColor Color
c :: String)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
lineNumberFill :: Text
lineNumberFill = case Style -> Maybe Color
lineNumberColor Style
f of
Maybe Color
Nothing -> Text
""
Just Color
c -> Text
"fill: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text
toTypstColor Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", "
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef Maybe Color
defaultcol [(TokenType, TokenStyle)]
tokstyles' TokenType
tokt =
Text
"#let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TokenType -> String
forall a. Show a => a -> String
show TokenType
tokt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(s) = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
ul (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {p}. p -> p
bg (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textstyle) (Text
"raw(s)")
where tokstyles :: Map TokenType TokenStyle
tokstyles = [(TokenType, TokenStyle)] -> Map TokenType TokenStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(TokenType, TokenStyle)]
tokstyles'
tokf :: TokenStyle
tokf = TokenStyle -> Maybe TokenStyle -> TokenStyle
forall a. a -> Maybe a -> a
fromMaybe TokenStyle
defStyle (Maybe TokenStyle -> TokenStyle) -> Maybe TokenStyle -> TokenStyle
forall a b. (a -> b) -> a -> b
$ TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
tokt Map TokenType TokenStyle
tokstyles
ul :: a -> a
ul a
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
then a
"underline(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
else a
x
bg :: p -> p
bg p
x = case TokenStyle -> Maybe Color
tokenBackground TokenStyle
tokf of
Maybe Color
Nothing -> p
x
Just Color
_c -> p
x
textstyle :: Text -> Text
textstyle Text
x = Text
"text(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
it Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
co Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
it :: Text
it = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
then Text
"style: \"italic\","
else Text
""
bf :: Text
bf = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
then Text
"weight: \"bold\","
else Text
""
co :: Text
co = case TokenStyle -> Maybe Color
tokenColor TokenStyle
tokf Maybe Color -> Maybe Color -> Maybe Color
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Color
defaultcol of
Just Color
c -> Text
"fill: rgb(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
String -> Text
Text.pack (String -> String
forall a. Show a => a -> String
show (Color -> String
forall a. FromColor a => Color -> a
fromColor Color
c :: String)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"),"
Maybe Color
Nothing -> Text
""