    {-# 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 :: Bool -> [SourceLine] -> Text
    formatLaTeX Bool
    inline = Text -> [Text] -> Text
    Text.intercalate (Char -> Text
    Text.singleton Char
    '\n')
                           ([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 (Bool -> SourceLine -> Text
    sourceLineToLaTeX Bool
    inline)

    -- | Formats tokens as LaTeX using custom commands inside
    -- @|@ characters. Assumes that @|@ is defined as a short verbatim
    -- command by the macros produced by 'styleToLaTeX'.
    -- A @KeywordTok@ is rendered using @\\KeywordTok{..}@, and so on.
    formatLaTeXInline :: FormatOptions -> [SourceLine] -> Text
    formatLaTeXInline :: FormatOptions -> [SourceLine] -> Text
    formatLaTeXInline FormatOptions
    _opts [SourceLine]
    ls = Text
    "\\VERB|" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Bool -> [SourceLine] -> Text
    formatLaTeX Bool
    True [SourceLine]
    ls Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "|"

    sourceLineToLaTeX :: Bool -> SourceLine -> Text
    sourceLineToLaTeX :: Bool -> SourceLine -> Text
    sourceLineToLaTeX Bool
    inline = [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 (Bool -> Token -> Text
    tokenToLaTeX Bool
    inline)

    tokenToLaTeX :: Bool -> Token -> Text
    tokenToLaTeX :: Bool -> Token -> Text
    tokenToLaTeX Bool
    inline (TokenType
    NormalTok, Text
    txt)
      | (Char -> Bool) -> Text -> Bool
    Text.all Char -> Bool
    isSpace Text
    txt = Bool -> Text -> Text
    escapeLaTeX Bool
    inline Text
    txt
    tokenToLaTeX Bool
    inline (TokenType
    toktype, Text
    txt)   = Char -> Text -> Text
    Text.cons Char
    '\\'
      (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
    <> Bool -> Text -> Text
    escapeLaTeX Bool
    inline Text
    txt Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "}")

    escapeLaTeX :: Bool -> Text -> Text
    escapeLaTeX :: Bool -> Text -> Text
    escapeLaTeX Bool
    inline = (Char -> Text) -> Text -> Text
    Text.concatMap Char -> Text
    escapeLaTeXChar
      where escapeLaTeXChar :: Char -> Text
    escapeLaTeXChar Char
    c =
             case Char
    c of
               Char
    '\\' -> Text
    "\\textbackslash{}"
               Char
    '{'  -> Text
    "\\{"
               Char
    '}'  -> Text
    "\\}"
               Char
    '|' | Bool
    inline -> Text
    "\\VerbBar{}" -- used in inline verbatim
               Char
    '_'  -> Text
    "\\_"
               Char
    '&'  -> Text
    "\\&"
               Char
    '%'  -> Text
    "\\%"
               Char
    '#'  -> Text
    "\\#"
               Char
    '`'  -> Text
    "\\textasciigrave{}"
               Char
    '\'' -> Text
    "\\textquotesingle{}"
               Char
    '-'  -> Text
    "{-}" -- prevent ligatures
               Char
    '~'  -> Text
    "\\textasciitilde{}"
               Char
    '^'  -> Text
    "\\^{}"
               Char
    '>'  -> Text
    "\\textgreater{}"
               Char
    '<'  -> Text
    "\\textless{}"
               Char
    _    -> Char -> Text
    Text.singleton Char
    c

    -- LaTeX

    -- | Format tokens as a LaTeX @Highlighting@ environment inside a
    -- @Shaded@ environment.  @Highlighting@ and @Shaded@ are
    -- defined by the macros produced by 'styleToLaTeX'.  @Highlighting@
    -- is a verbatim environment using @fancyvrb@; @\\@, @{@, and @}@
    -- have their normal meanings inside this environment, so that
    -- formatting commands work.  @Shaded@ is either nothing
    -- (if the style's background color is default) or a @snugshade@
    -- environment from @framed@, providing a background color
    -- for the whole code block, even if it spans multiple pages.
    formatLaTeXBlock :: FormatOptions -> [SourceLine] -> Text
    formatLaTeXBlock :: FormatOptions -> [SourceLine] -> Text
    formatLaTeXBlock FormatOptions
    opts [SourceLine]
    ls = [Text] -> Text
    Text.unlines
      [Text
    "\\begin{Shaded}"
      ,Text
    "\\begin{Highlighting}[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
       (if FormatOptions -> Bool
    numberLines FormatOptions
    opts
           then Text
    "numbers=left," Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                (if FormatOptions -> Int
    startNumber FormatOptions
    opts Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
                    then Text
    ""
                    else Text
    ",firstnumber=" 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.empty) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "]"
      ,Bool -> [SourceLine] -> Text
    formatLaTeX Bool
    False [SourceLine]
    ls
      ,Text
    "\\end{Highlighting}"
      ,Text
    "\\end{Shaded}"]

    -- | Converts a 'Style' to a set of LaTeX macro definitions,
    -- which should be placed in the document's preamble.
    -- Note: default LaTeX setup doesn't allow boldface typewriter font.
    -- To make boldface work in styles, you need to use a different typewriter
    -- font. This will work for computer modern:
    --
    -- > \DeclareFontShape{OT1}{cmtt}{bx}{n}{<5><6><7><8><9><10><10.95><12><14.4><17.28><20.74><24.88>cmttb10}{}
    --
    -- Or, with xelatex:
    --
    -- > \usepackage{fontspec}
    -- > \setmainfont[SmallCapsFont={* Caps}]{Latin Modern Roman}
    -- > \setsansfont{Latin Modern Sans}
    -- > \setmonofont[SmallCapsFont={Latin Modern Mono Caps}]{Latin Modern Mono Light}
    --
    styleToLaTeX :: Style -> Text
    styleToLaTeX :: Style -> Text
    styleToLaTeX Style
    f = [Text] -> Text
    Text.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $
      [ Text
    "\\usepackage{color}"
      , Text
    "\\usepackage{fancyvrb}"
      , Text
    "\\newcommand{\\VerbBar}{|}"
      , Text
    "\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}"
      , Text
    "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
      , Text
    "% Add ',fontsize=\\small' for more characters per line"
      ] [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++
      (case Style -> Maybe Color
    backgroundColor Style
    f of
            Maybe Color
    Nothing          -> [Text
    "\\newenvironment{Shaded}{}{}"]
            Just (RGB Word8
    r Word8
    g Word8
    b) -> [Text
    "\\usepackage{framed}"
                                ,String -> Text
    Text.pack
                                  (String -> Word8 -> Word8 -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "\\definecolor{shadecolor}{RGB}{%d,%d,%d}" Word8
    r Word8
    g Word8
    b)
                                ,Text
    "\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"])
      [Text] -> [Text] -> [Text]
    forall 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))

    macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
    macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text
    macrodef Maybe Color
    defaultcol [(TokenType, TokenStyle)]
    tokstyles TokenType
    tokt = Text
    "\\newcommand{\\"
      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
    "}[1]{"
      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    Text.pack (String -> String
    forall {t}. (PrintfArg t, PrintfType t) => t -> t
    co (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. (Semigroup a, IsString a) => a -> a
    ul (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. (Semigroup a, IsString a) => a -> a
    bf (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. (Semigroup a, IsString a) => a -> a
    it (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {t}. (PrintfArg t, PrintfType t) => t -> t
    bg (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "#1")
      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "}"
      where tokf :: TokenStyle
    tokf = case TokenType -> [(TokenType, TokenStyle)] -> Maybe TokenStyle
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup TokenType
    tokt [(TokenType, TokenStyle)]
    tokstyles of
                         Maybe TokenStyle
    Nothing -> TokenStyle
    defStyle
                         Just TokenStyle
    x  -> TokenStyle
    x
            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
            it :: a -> a
    it a
    x = if TokenStyle -> Bool
    tokenItalic TokenStyle
    tokf
                      then a
    "\\textit{" 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
            bf :: a -> a
    bf a
    x = if TokenStyle -> Bool
    tokenBold TokenStyle
    tokf
                      then a
    "\\textbf{" 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
            bcol :: Maybe (Double, Double, Double)
    bcol = Color -> (Double, Double, Double)
    forall a. FromColor a => Color -> a
    fromColor (Color -> (Double, Double, Double))
    -> Maybe Color -> Maybe (Double, Double, Double)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` TokenStyle -> Maybe Color
    tokenBackground TokenStyle
    tokf
                      :: Maybe (Double, Double, Double)
            bg :: t -> t
    bg t
    x = case Maybe (Double, Double, Double)
    bcol of
                        Maybe (Double, Double, Double)
    Nothing        -> t
    x
                        Just (Double
    r, Double
    g, Double
    b) ->
                           String -> Double -> Double -> Double -> t -> t
    forall r. PrintfType r => String -> r
    printf String
    "\\colorbox[rgb]{%0.2f,%0.2f,%0.2f}{%s}" Double
    r Double
    g Double
    b t
    x
            col :: Maybe (Double, Double, Double)
    col  = Color -> (Double, Double, Double)
    forall a. FromColor a => Color -> a
    fromColor (Color -> (Double, Double, Double))
    -> Maybe Color -> Maybe (Double, Double, Double)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (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)
                      :: Maybe (Double, Double, Double)
            co :: t -> t
    co t
    x = case Maybe (Double, Double, Double)
    col of
                        Maybe (Double, Double, Double)
    Nothing        -> t
    x
                        Just (Double
    r, Double
    g, Double
    b) ->
                            String -> Double -> Double -> Double -> t -> t
    forall r. PrintfType r => String -> r
    printf String
    "\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" Double
    r Double
    g Double
    b t
    x