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