{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE PatternSynonyms   #-}
-- | Render analyzed input into LaTeX table.
module Render.Latex(latexFromColSpans, latexInline, latexPackages, subAndSuperscripts) where

import           Data.Text(Text)
import qualified Data.Text as T
import           Data.Char(isAlpha, isAsciiLower, isAsciiUpper, isDigit)

import           Text.LaTeX.Base.Syntax(protectText)
import           Data.Maybe (fromMaybe)

import           Alignment ( Align(..) )
import           Render.Common(TokensWithColSpan)
import           Token(MyTok(..))
import           Util(unbrace)

-- | Protect special LaTeX characters for use in math mode.
--   Handles Haskell operators with backslashes that Skylighting doesn't tokenize properly.
protectTextMath :: Text -> Text
protectTextMath :: Text -> Text
protectTextMath = Text -> Text
processText
  where
    processText :: Text -> Text
    processText :: Text -> Text
processText Text
t
      | Text -> Bool
T.null Text
t = Text
""
      -- Handle specific multi-character operators first
      | Text
"\\\\" Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text
"\\setminus " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText (Int -> Text -> Text
T.drop Int
2 Text
t)
      | Text
"\\/" Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text
"\\land " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText (Int -> Text -> Text
T.drop Int
2 Text
t)
      | Text
"/\\" Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text
"\\lor " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText (Int -> Text -> Text
T.drop Int
2 Text
t)
      -- Handle lambda: backslash followed by letter/digit
      | Just (Char
'\\', Text
rest) <- Text -> Maybe (Char, Text)
T.uncons Text
t
      , Just (Char
nextChar, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
rest
      , Char -> Bool
isAlphaNum Char
nextChar = Text
"\\lambda " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText Text
rest
      -- Handle standalone backslash followed by operator chars
      | Just (Char
'\\', Text
rest) <- Text -> Maybe (Char, Text)
T.uncons Text
t = Text
"\\backslash " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText Text
rest
      -- Handle other special chars
      | Bool
otherwise =
          let (Char
c, Text
rest) = (Char, Text) -> Maybe (Char, Text) -> (Char, Text)
forall a. a -> Maybe a -> a
fromMaybe (Char
' ', Text
"") (Maybe (Char, Text) -> (Char, Text))
-> Maybe (Char, Text) -> (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Char, Text)
T.uncons Text
t
          in Char -> Text
escapeChar Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
processText Text
rest

    escapeChar :: Char -> Text
    escapeChar :: Char -> Text
escapeChar Char
'#'  = Text
"\\#"
    escapeChar Char
'$'  = Text
"\\$"
    escapeChar Char
'%'  = Text
"\\%"
    escapeChar Char
'&'  = Text
"\\&"
    escapeChar Char
'_'  = Text
"\\_"
    escapeChar Char
'{'  = Text
"\\{"
    escapeChar Char
'}'  = Text
"\\}"
    escapeChar Char
c    = Char -> Text
T.singleton Char
c

    isAlphaNum :: Char -> Bool
    isAlphaNum :: Char -> Bool
isAlphaNum Char
c = Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c

-- | Given a number of table columns,
--   and a list of lists of colspans for each table row,
--   return raw LaTeX code.
latexFromColSpans :: Int -> [[TokensWithColSpan]] -> Text
latexFromColSpans :: Int -> [[TokensWithColSpan]] -> Text
latexFromColSpans Int
cols =
    Int -> Text -> Text
wrapTable Int
cols
  (Text -> Text)
-> ([[TokensWithColSpan]] -> Text) -> [[TokensWithColSpan]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
  ([Text] -> Text)
-> ([[TokensWithColSpan]] -> [Text])
-> [[TokensWithColSpan]]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokensWithColSpan] -> Text) -> [[TokensWithColSpan]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\\\")
         (Text -> Text)
-> ([TokensWithColSpan] -> Text) -> [TokensWithColSpan] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" & "
         ([Text] -> Text)
-> ([TokensWithColSpan] -> [Text]) -> [TokensWithColSpan] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokensWithColSpan -> Text) -> [TokensWithColSpan] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TokensWithColSpan -> Text
renderColSpan )

-- | Render a single colspan as LaTeX \multicolumn.
renderColSpan :: TokensWithColSpan -> Text
renderColSpan :: TokensWithColSpan -> Text
renderColSpan ([(MyTok
TBlank, Text
txt)], Int
colSpan, Align
AIndent) = -- indentation
    [Text] -> Text
T.concat [ Text
"\\multicolumn{",    String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
colSpan
                          , Text
"}{p{", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
txt
                          , Text
"ex}}{",  Text -> Text
protectText Text
txt
                          , Text
"\\,}" ]
renderColSpan ([(MyTok, Text)]
toks, Int
colSpan, Align
alignment) =
    [Text] -> Text
T.concat [ Text
"\\multicolumn{",  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
colSpan
                          , Text
"}{", Align -> Text
forall {a}. IsString a => Align -> a
alignMark Align
alignment
                          , Text
"}{$", [(MyTok, Text)] -> Text
latexInline [(MyTok, Text)]
toks
                          , Text
"$}" ]
  where
    alignMark :: Align -> a
alignMark Align
ACenter = a
"c"
    alignMark Align
ALeft   = a
"l"
    alignMark Align
AIndent = a
"l"

-- | Wrap a LaTeX table content into \begin{tabular} environment.
wrapTable :: Int -> Text -> Text
wrapTable :: Int -> Text -> Text
wrapTable Int
cols Text
txt =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [-- "\\newlength{\\tabcolsepBACKUP}\n"
           -- ,"\\setlength{\\tabcolsepBACKUP}{\\tabcolsep}"
            Text
"\\setlength{\\tabcolsep}{1pt}\n"
          , Text
"\\begin{tabular}{"
          , Int -> Text -> Text
T.replicate (Int
colsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
"l" -- FIXME: tests for correct number of columns
          , Text
"}\n"
          , Text
txt, Text
"\n\\end{tabular}"
           --,"\\setlength{\\tabcolsep}{\\tabcolsepBACKUP}"
          ]

-- Decrease column spacing: \\setlength{\\tabcolsep}{1ex}
-- TODO: braced operators
-- | Preprocesses functions converted to operator syntax and joins them into a single token.
-- FIXME: deduplicate
preformatTokens :: [(MyTok, b)] -> [(MyTok, b)]
preformatTokens []                                                     = []
preformatTokens ((MyTok
TOther, b
"`"):(MyTok
TVar, b
"elem"):(MyTok
TOther, b
"`"):[(MyTok, b)]
rest) = (MyTok
TOperator, b
"elem")(MyTok, b) -> [(MyTok, b)] -> [(MyTok, b)]
forall a. a -> [a] -> [a]
:[(MyTok, b)] -> [(MyTok, b)]
preformatTokens [(MyTok, b)]
rest
preformatTokens ((MyTok, b)
a                                              :[(MyTok, b)]
rest) =  (MyTok, b)
a                 (MyTok, b) -> [(MyTok, b)] -> [(MyTok, b)]
forall a. a -> [a] -> [a]
:[(MyTok, b)] -> [(MyTok, b)]
preformatTokens [(MyTok, b)]
rest


-- | Format a list of tokens within a colspan.
--   Preprocesses then and calls `formatToken` for each.
latexInline :: [(MyTok, Text)] -> Text
latexInline :: [(MyTok, Text)] -> Text
latexInline  = [Text] -> Text
T.concat
             ([Text] -> Text)
-> ([(MyTok, Text)] -> [Text]) -> [(MyTok, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MyTok, Text) -> Text) -> [(MyTok, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MyTok, Text) -> Text
formatToken
             ([(MyTok, Text)] -> [Text])
-> ([(MyTok, Text)] -> [(MyTok, Text)])
-> [(MyTok, Text)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> [(MyTok, Text)]
forall {b}. (Eq b, IsString b) => [(MyTok, b)] -> [(MyTok, b)]
preformatTokens

-- | Add subscripts and superscripts to variable names.
--   "_" is subscript, and "__" is superscript.
--   Superscripts nest their remaining content recursively.
subAndSuperscripts :: Text -> Text
subAndSuperscripts :: Text -> Text
subAndSuperscripts Text
""  = Text
" "
subAndSuperscripts Text
"_" = Text
"\\_"
subAndSuperscripts Text
t   = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"_" Text
t of
  [] -> Text
""
  (Text
x:[Text]
xs) -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
processSegments [Text]
xs
  where
    -- Process segments after splitting by "_"
    -- Empty string indicates double underscore (superscript)
    processSegments :: [Text] -> Text
    processSegments :: [Text] -> Text
processSegments [] = Text
""
    processSegments (Text
"":[Text]
rest) = case [Text]
rest of
      [] -> Text
""  -- Trailing "__"
      [Text]
_  -> let remainingText :: Text
remainingText = Text -> [Text] -> Text
T.intercalate Text
"_" [Text]
rest
            in Text
"\\textsuperscript{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
subAndSuperscripts Text
remainingText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
    processSegments (Text
x:[Text]
xs) = Text
"\\textsubscript{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
processSegments [Text]
xs

-- | Pattern for operator-like tokens (TOperator or TOther).
--   Both tokenizers produce different token types for the same operators:
--   - Haskell tokenizer: most operators → TOther
--   - Skylighting tokenizer: some operators → TOperator (e.g., *, >-, -<, >>-, -<<)
--   This pattern synonym eliminates duplication when handling the same operator from both tokenizers.
pattern OpOrOther :: Text -> (MyTok, Text)
pattern $mOpOrOther :: forall {r}. (MyTok, Text) -> (Text -> r) -> ((# #) -> r) -> r
OpOrOther txt <- (matchOpOrOther -> Just txt)

matchOpOrOther :: (MyTok, Text) -> Maybe Text
matchOpOrOther :: (MyTok, Text) -> Maybe Text
matchOpOrOther (MyTok
TOperator, Text
txt) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
matchOpOrOther (MyTok
TOther,    Text
txt) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
matchOpOrOther (MyTok, Text)
_                = Maybe Text
forall a. Maybe a
Nothing

-- Workaround with joinEscapedOperators til w consider spaces only.
-- | Render a simple token.
formatToken :: (MyTok, Text) -> Text
formatToken :: (MyTok, Text) -> Text
formatToken (MyTok
TOperator,Text -> Maybe Text
unbrace -> Just Text
op) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (MyTok, Text) -> Text
formatToken (MyTok
TOperator, Text
op) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
-- GHC UnicodeSyntax extension operators
-- See: https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/unicode_syntax.html
-- Note: ∀ can be TKeyword (Haskell) or TOther (Skylighting)
formatToken (MyTok
TKeyword, Text
"forall") = Text -> Text
mathop Text
"forall"
formatToken (MyTok
TKeyword, Text
"∀"     ) = Text -> Text
mathop Text
"forall"
formatToken (OpOrOther Text
"∀") = Text -> Text
mathop Text
"forall"
--formatToken (TVar,     "mempty") = mathop "emptyset"
formatToken (MyTok
TVar,     Text
"bottom") = Text -> Text
mathop Text
"bot"
formatToken (MyTok
TVar,  Text
"undefined") = Text -> Text
mathop Text
"perp"
formatToken (MyTok
TVar,     Text
"top"   ) = Text -> Text
mathop Text
"top"
formatToken (MyTok
TVar,     Text
"not"   ) = Text -> Text
mathop Text
"neg"
--formatToken (TOperator,">>="   ) = mathop "mathbin{>\\!\\!\\!>\\!\\!=}" -- from lhs2TeX, Neil Mitchell's
formatToken (MyTok
TOperator,Text
">>="   ) = Text -> Text
mathop Text
"mathbin{\\gg\\!\\!=}" -- from lhs2TeX, Neil Mitchell's
formatToken (MyTok
TOperator,Text
"=<<"   ) = Text -> Text
mathop Text
"mathbin{=\\!\\!<\\!\\!\\!<}" -- from lhs2TeX, Neil Mitchell's
formatToken (MyTok
TOperator,Text
">=>"   ) = Text -> Text
mathop Text
"mathbin{>\\!\\!=\\!\\!\\!>}"
formatToken (MyTok
TOperator,Text
"|-"    ) = Text -> Text
mathop Text
"vdash"
formatToken (MyTok
TOperator,Text
"/\\"   ) = Text -> Text
mathop Text
"lor"
formatToken (MyTok
TOperator,Text
"\\/"   ) = Text -> Text
mathop Text
"land"
formatToken (MyTok
TOperator,Text
"\\|/"  ) = Text -> Text
mathop Text
"downarrow"
formatToken (MyTok
TOperator,Text
"\\||/" ) = Text -> Text
mathop Text
"Downarrow"
formatToken (MyTok
TOperator,Text
"/|\\"  ) = Text -> Text
mathop Text
"uparrow"
formatToken (MyTok
TOperator,Text
"/||\\" ) = Text -> Text
mathop Text
"Uparrow"
formatToken (MyTok
TOperator,Text
"~>"    ) = Text -> Text
mathop Text
"leadsto"
formatToken (MyTok
TOperator,Text
"|="    ) = Text -> Text
mathop Text
"models"
formatToken (MyTok
TCons    ,Text
"Natural") = Text
"\\mathbb{N}"
formatToken (MyTok
TCons    ,Text
"Integer") = Text
"\\mathbb{Z}"
formatToken (MyTok
TOperator,Text
"|"     ) = Text -> Text
mathop Text
"alt"
formatToken (MyTok
TOperator,Text
"||"    ) = Text -> Text
mathop Text
"parallel"
formatToken (MyTok
TOperator,Text
"|>"    ) = Text -> Text
mathop Text
"triangleright"
--formatToken (TOperator,">>"    ) = mathop "mathbin{>\\!\\!\\!>}" -- gg
--formatToken (TOperator,">>>"   ) = mathop "mathbin{>\\!\\!\\!>\\!\\!\\!>}" -- gg
formatToken (MyTok
TOperator,Text
">>"    ) = Text -> Text
mathop Text
"gg"
formatToken (MyTok
TOperator,Text
">>>"   ) = Text -> Text
mathop Text
"ggg"
formatToken (MyTok
TOperator,Text
"<<"    ) = Text -> Text
mathop Text
"ll"
formatToken (MyTok
TOperator,Text
"<<<"   ) = Text -> Text
mathop Text
"lll"
formatToken (MyTok
TOperator,Text
"\\\\"  ) = Text -> Text
mathop Text
"setminus" -- MUST come before single backslash!
formatToken (OpOrOther Text
"\\") = Text -> Text
mathop Text
"lambda" -- Lambda (both tokenizers)
formatToken (OpOrOther Text
"λ")  = Text -> Text
mathop Text
"lambda" -- Unicode lambda (TOther from Skylighting)
formatToken (MyTok
TVar,     Text
"λ"     ) = Text -> Text
mathop Text
"lambda" -- Unicode lambda (TVar from Haskell tokenizer)
formatToken (OpOrOther Text
"-<") = Text -> Text
mathop Text
"prec" -- Left arrow-tail
formatToken (OpOrOther Text
"⤙")  = Text -> Text
mathop Text
"prec" -- Unicode -<
formatToken (OpOrOther Text
">-") = Text -> Text
mathop Text
"succ" -- Right arrow-tail
formatToken (OpOrOther Text
"⤚")  = Text -> Text
mathop Text
"succ" -- Unicode >-
formatToken (OpOrOther Text
"<-") = Text -> Text
mathop Text
"gets" -- Left arrow
formatToken (OpOrOther Text
"←")  = Text -> Text
mathop Text
"gets" -- Unicode <-
formatToken (MyTok
TOperator,Text
">="    ) = Text -> Text
mathop Text
"geq"
formatToken (MyTok
TOperator,Text
"<="    ) = Text -> Text
mathop Text
"leq"
formatToken (MyTok
TOperator,Text
"!="    ) = Text -> Text
mathop Text
"ne"
formatToken (MyTok
TOperator,Text
"<->"   ) = Text -> Text
mathop Text
"updownarrow"
formatToken (MyTok
TOperator,Text
"<|>"   ) = Text -> Text
mathop Text
"leftrightarrow"
formatToken (OpOrOther Text
"->") = Text -> Text
mathop Text
"to"
formatToken (OpOrOther Text
"→")  = Text -> Text
mathop Text
"to"      -- Unicode ->
formatToken (OpOrOther Text
"=>") = Text -> Text
mathop Text
"Rightarrow"
formatToken (OpOrOther Text
"⇒")  = Text -> Text
mathop Text
"Rightarrow" -- Unicode =>
formatToken (OpOrOther Text
"::") = Text -> Text
mathop Text
":"       -- Type annotation
formatToken (OpOrOther Text
"∷")  = Text -> Text
mathop Text
":"       -- Unicode ::
-- Note: * is rendered as \times (multiplication) since modern Haskell uses Type for kinds
-- TODO: Make this configurable for legacy code that uses * for kinds
formatToken (OpOrOther Text
"*")  = Text -> Text
mathop Text
"times"   -- Multiplication (star for old kind syntax)
formatToken (OpOrOther Text
"★")  = Text -> Text
mathop Text
"star"    -- Unicode kind star
formatToken (OpOrOther Text
">>-") = Text -> Text
mathop Text
"rr"     -- Right double arrow-tail
formatToken (OpOrOther Text
"⤜")  = Text -> Text
mathop Text
"rr"      -- Unicode >>-
formatToken (OpOrOther Text
"-<<") = Text -> Text
mathop Text
"ll"     -- Left double arrow-tail
formatToken (OpOrOther Text
"⤛")  = Text -> Text
mathop Text
"ll"      -- Unicode -<<
formatToken (OpOrOther Text
"⊸")  = Text -> Text
mathop Text
"multimap" -- Unicode linear arrow %1->
formatToken (OpOrOther Text
"(|") = Text -> Text
mathop Text
"llparenthesis" -- Parallel array bracket (stmaryrd)
formatToken (OpOrOther Text
"⦇")  = Text -> Text
mathop Text
"llparenthesis" -- Unicode (|
formatToken (OpOrOther Text
"|)") = Text -> Text
mathop Text
"rrparenthesis" -- Parallel array bracket (stmaryrd)
formatToken (OpOrOther Text
"⦈")  = Text -> Text
mathop Text
"rrparenthesis" -- Unicode |)
formatToken (OpOrOther Text
"[|") = Text -> Text
mathop Text
"llbracket" -- Quasiquote bracket (stmaryrd)
formatToken (OpOrOther Text
"⟦")  = Text -> Text
mathop Text
"llbracket" -- Unicode [|
formatToken (OpOrOther Text
"|]") = Text -> Text
mathop Text
"rrbracket" -- Quasiquote bracket (stmaryrd)
formatToken (OpOrOther Text
"⟧")  = Text -> Text
mathop Text
"rrbracket" -- Unicode |]
formatToken (MyTok
TOperator,Text
"==>"   ) = Text -> Text
mathop Text
"implies"
formatToken (MyTok
TOperator,Text
"|->"   ) = Text -> Text
mathop Text
"mapsto"
formatToken (MyTok
TOperator,Text
"|=>"   ) = Text -> Text
mathop Text
"Mapsto" -- requires stmaryrd
formatToken (MyTok
TOperator,Text
"<>"    ) = Text -> Text
mathop Text
"diamond"
formatToken (MyTok
TOperator,Text
"<$>"   ) = Text -> Text
mathop Text
"mathbin{\\ooalign{\\raise.29ex\\hbox{$\\scriptscriptstyle\\$$}\\cr\\hss$\\!\\lozenge$\\hss}}"
formatToken (MyTok
TOperator,Text
"<*>"   ) = Text -> Text
mathop Text
"mathbin{\\ooalign{\\raise.37ex\\hbox{$\\scriptscriptstyle{*}$}\\cr\\hss$\\!\\lozenge$\\hss}}"
formatToken (MyTok
TOperator,Text
"elem"  ) = Text -> Text
mathop Text
"in"
formatToken (MyTok
TOperator,Text
"~"     ) = Text -> Text
mathop Text
"sim"
formatToken (MyTok
TOperator,Text
"~="    ) = Text -> Text
mathop Text
"approx"
formatToken (MyTok
TOperator,Text
"><"    ) = Text -> Text
mathop Text
"times"
formatToken (MyTok
TOperator,Text
":->"   ) = Text -> Text
mathop Text
"longmapsto"
formatToken (MyTok
TVar,     Text
"a"     ) = Text -> Text
mathop Text
"alpha"
formatToken (MyTok
TVar,     Text
"b"     ) = Text -> Text
mathop Text
"beta"
formatToken (MyTok
TVar,     Text
"c"     ) = Text -> Text
mathop Text
"gamma"
formatToken (MyTok
TVar,     Text
"d"     ) = Text -> Text
mathop Text
"delta"
formatToken (MyTok
TVar,     Text
"eps"   ) = Text -> Text
mathop Text
"epsilon"
formatToken (MyTok
TVar,     Text
"k"     ) = Text -> Text
mathop Text
"kappa"
formatToken (MyTok
TVar,     Text
"n"     ) = Text -> Text
mathop Text
"nu"
formatToken (MyTok
TVar,     Text
"m"     ) = Text -> Text
mathop Text
"mu"
formatToken (MyTok
TVar,     Text
"sigma" ) = Text -> Text
mathop Text
"sigma"
formatToken (MyTok
TVar,     Text
"omega" ) = Text -> Text
mathop Text
"omega"
formatToken (MyTok
TVar,     Text
"pi"    ) = Text -> Text
mathop Text
"pi"
formatToken (MyTok
TVar,     Text
"tau"   ) = Text -> Text
mathop Text
"tau"
formatToken (MyTok
TVar,     Text
"rho"   ) = Text -> Text
mathop Text
"rho"
formatToken (MyTok
TVar    , Text
txt     ) | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isAlpha Text
txt = Text
"\\textit{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
subAndSuperscripts Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
formatToken (MyTok
TVar,     Text
txt     ) = Text
"\\textit{"     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
protectText Text
txt  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
formatToken (MyTok
TNum    , Text
kwd     ) = Text -> Text
protectText Text
kwd
formatToken (MyTok
TKeyword, Text
kwd     ) = Text
"\\textbf{"     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
protectText Text
kwd  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
formatToken (MyTok
TCons,    Text
cons    ) = Text
"\\textsc{"     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
subAndSuperscripts Text
cons Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
--formatToken (TOperator,"\\"    ) = mathop "lambda"
formatToken (TTikz Text
mark,Text
_      ) = Text -> Text
mathop (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"tikzMark{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mark Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
--formatToken (TOther,   "`"     ) = mathop "textasciigrave"
formatToken (MyTok
TOther,   Text
"`"     ) = Text -> Text
protectText Text
"`"
formatToken (MyTok
TOther,   Text
"'"     ) = Text -> Text
mathop Text
"prime"
formatToken (MyTok
TOther,   Text
"\""     ) = Text -> Text
protectText Text
"\""
formatToken (MyTok
TOther,   Text
"("     ) = Text -> Text
protectText Text
"("
formatToken (MyTok
TOther,   Text
")"     ) = Text -> Text
protectText Text
")"
formatToken (MyTok
TOther,   Text
"]"     ) = Text -> Text
protectText Text
"]"
formatToken (MyTok
TOther,   Text
"["     ) = Text -> Text
protectText Text
"["
formatToken (MyTok
TOther,   Text
"}"     ) = Text -> Text
protectText Text
"}"
formatToken (MyTok
TOther,   Text
"{"     ) = Text -> Text
protectText Text
"{"
--formatToken (TOther,   "="     ) = "\\scalebox{1.7}{" <> mathop "=" <> "}"
formatToken (MyTok
TOther,   Text
"="     ) = Text
"=\\joinrel="
-- formatToken (TBlank,   txt  ) = "\\textit{\\textcolor{gray}{" <> protectText txt <> "}}"
formatToken (MyTok
_,  Text
txt           ) = Text
"\\textrm{"     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
protectTextMath Text
txt  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

mathop :: Text -> Text
mathop :: Text -> Text
mathop Text
code = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code

prologue :: Text
prologue :: Text
prologue = [Text] -> Text
T.concat [Text
"\\usepackage{amssymb}"]

latexPackages :: [Text]
latexPackages :: [Text]
latexPackages  = [Text
"amssymb", Text
"amsmath", Text
"stmaryrd"]