{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Skylighting.Format.LaTeX (
formatLaTeXInline
, formatLaTeXBlock
, styleToLaTeX
) where
import Control.Monad (mplus)
import Data.Char (isSpace)
import Data.List (sort)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Skylighting.Types
import Text.Printf
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
formatLaTeX :: Bool -> [SourceLine] -> Text
formatLaTeX inline = Text.intercalate (Text.singleton '\n')
. map (sourceLineToLaTeX inline)
formatLaTeXInline :: FormatOptions -> [SourceLine] -> Text
formatLaTeXInline _opts ls = "\\VERB|" <> formatLaTeX True ls <> "|"
sourceLineToLaTeX :: Bool -> SourceLine -> Text
sourceLineToLaTeX inline = mconcat . map (tokenToLaTeX inline)
tokenToLaTeX :: Bool -> Token -> Text
tokenToLaTeX inline (NormalTok, txt)
| Text.all isSpace txt = escapeLaTeX inline txt
tokenToLaTeX inline (toktype, txt) = Text.cons '\\'
(Text.pack (show toktype) <> "{" <> escapeLaTeX inline txt <> "}")
escapeLaTeX :: Bool -> Text -> Text
escapeLaTeX inline = Text.concatMap escapeLaTeXChar
where escapeLaTeXChar c =
case c of
'\\' -> "\\textbackslash{}"
'{' -> "\\{"
'}' -> "\\}"
'|' | inline -> "\\VerbBar{}"
'_' -> "\\_"
'&' -> "\\&"
'%' -> "\\%"
'#' -> "\\#"
'`' -> "\\textasciigrave{}"
'\'' -> "\\textquotesingle{}"
'-' -> "{-}"
'~' -> "\\textasciitilde{}"
'^' -> "\\^{}"
'>' -> "\\textgreater{}"
'<' -> "\\textless{}"
_ -> Text.singleton c
formatLaTeXBlock :: FormatOptions -> [SourceLine] -> Text
formatLaTeXBlock opts ls = Text.unlines
["\\begin{Shaded}"
,"\\begin{Highlighting}[" <>
(if numberLines opts
then "numbers=left," <>
(if startNumber opts == 1
then ""
else ",firstnumber=" <>
Text.pack (show (startNumber opts))) <> ","
else Text.empty) <> "]"
,formatLaTeX False ls
,"\\end{Highlighting}"
,"\\end{Shaded}"]
styleToLaTeX :: Style -> Text
styleToLaTeX f = Text.unlines $
[ "\\usepackage{color}"
, "\\usepackage{fancyvrb}"
, "\\newcommand{\\VerbBar}{|}"
, "\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}"
, "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
, "% Add ',fontsize=\\small' for more characters per line"
] ++
(case backgroundColor f of
Nothing -> ["\\newenvironment{Shaded}{}{}"]
Just (RGB r g b) -> ["\\usepackage{framed}"
,Text.pack
(printf "\\definecolor{shadecolor}{RGB}{%d,%d,%d}" r g b)
,"\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"])
++ sort (map (macrodef (defaultColor f) (Map.toList (tokenStyles f)))
(enumFromTo KeywordTok NormalTok))
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
macrodef defaultcol tokstyles tokt = "\\newcommand{\\"
<> Text.pack (show tokt)
<> "}[1]{"
<> Text.pack (co . ul . bf . it . bg $ "#1")
<> "}"
where tokf = case lookup tokt tokstyles of
Nothing -> defStyle
Just x -> x
ul x = if tokenUnderline tokf
then "\\underline{" <> x <> "}"
else x
it x = if tokenItalic tokf
then "\\textit{" <> x <> "}"
else x
bf x = if tokenBold tokf
then "\\textbf{" <> x <> "}"
else x
bcol = fromColor `fmap` tokenBackground tokf
:: Maybe (Double, Double, Double)
bg x = case bcol of
Nothing -> x
Just (r, g, b) ->
printf "\\colorbox[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x
col = fromColor `fmap` (tokenColor tokf `mplus` defaultcol)
:: Maybe (Double, Double, Double)
co x = case col of
Nothing -> x
Just (r, g, b) ->
printf "\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x