{-# 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

-- | Formats tokens as Typst using custom commands inside
-- @|@ characters. Assumes that @|@ is defined as a short verbatim
-- command by the macros produced by 'styleToTypst'.
-- A @KeywordTok@ is rendered using @\\KeywordTok{..}@, and so on.
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

-- Typst

-- | Format tokens as a Typst @Highlighting@ environment inside a
-- Skylighting block that can be styled. @Skylighting@ is
-- defined by the macros produced by 'styleToTypst'.
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
<> -- an array
  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
"));"

-- | Converts a 'Style' to a set of Typst macro definitions,
-- which should be placed in the document's preamble.
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 -- TODO?
       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
""