{-# 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 inline :: Bool
inline = Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton '\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 _opts :: FormatOptions
_opts ls :: [SourceLine]
ls = "\\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
<> "|"

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

escapeLaTeX :: Bool -> Text -> Text
escapeLaTeX :: Bool -> Text -> Text
escapeLaTeX inline :: Bool
inline = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
escapeLaTeXChar
  where escapeLaTeXChar :: Char -> Text
escapeLaTeXChar c :: Char
c =
         case Char
c of
           '\\' -> "\\textbackslash{}"
           '{'  -> "\\{"
           '}'  -> "\\}"
           '|' | Bool
inline -> "\\VerbBar{}" -- used in inline verbatim
           '_'  -> "\\_"
           '&'  -> "\\&"
           '%'  -> "\\%"
           '#'  -> "\\#"
           '`'  -> "\\textasciigrave{}"
           '\'' -> "\\textquotesingle{}"
           '-'  -> "{-}" -- prevent ligatures
           '~'  -> "\\textasciitilde{}"
           '^'  -> "\\^{}"
           '>'  -> "\\textgreater{}"
           '<'  -> "\\textless{}"
           _    -> 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 opts :: FormatOptions
opts ls :: [SourceLine]
ls = [Text] -> Text
Text.unlines
  ["\\begin{Shaded}"
  ,"\\begin{Highlighting}[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
   (if FormatOptions -> Bool
numberLines FormatOptions
opts
       then "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
== 1
                then ""
                else ",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
<> ","
       else Text
Text.empty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
  ,Bool -> [SourceLine] -> Text
formatLaTeX Bool
False [SourceLine]
ls
  ,"\\end{Highlighting}"
  ,"\\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 f :: Style
f = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
  [ "\\usepackage{color}"
  , "\\usepackage{fancyvrb}"
  , "\\newcommand{\\VerbBar}{|}"
  , "\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}"
  , "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
  , "% Add ',fontsize=\\small' for more characters per line"
  ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
  (case Style -> Maybe Color
backgroundColor Style
f of
        Nothing          -> ["\\newenvironment{Shaded}{}{}"]
        Just (RGB r :: Word8
r g :: Word8
g b :: Word8
b) -> ["\\usepackage{framed}"
                            ,String -> Text
Text.pack
                              (String -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf "\\definecolor{shadecolor}{RGB}{%d,%d,%d}" Word8
r Word8
g Word8
b)
                            ,"\\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 defaultcol :: Maybe Color
defaultcol tokstyles :: [(TokenType, TokenStyle)]
tokstyles tokt :: TokenType
tokt = "\\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
<> "}[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 p. (Semigroup p, IsString p) => p -> p
ul (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall p. (Semigroup p, IsString p) => p -> p
bf (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall p. (Semigroup p, IsString p) => p -> p
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
$ "#1")
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
  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
                     Nothing -> TokenStyle
defStyle
                     Just x :: TokenStyle
x  -> TokenStyle
x
        ul :: p -> p
ul x :: p
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
                  then "\\underline{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> "}"
                  else p
x
        it :: p -> p
it x :: p
x = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
                  then "\\textit{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> "}"
                  else p
x
        bf :: p -> p
bf x :: p
x = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
                  then "\\textbf{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> "}"
                  else p
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 (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 x :: t
x = case Maybe (Double, Double, Double)
bcol of
                    Nothing        -> t
x
                    Just (r :: Double
r, g :: Double
g, b :: Double
b) ->
                       String -> Double -> Double -> Double -> t -> t
forall r. PrintfType r => String -> r
printf "\\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 (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 (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Color
defaultcol)
                  :: Maybe (Double, Double, Double)
        co :: t -> t
co x :: t
x = case Maybe (Double, Double, Double)
col of
                    Nothing        -> t
x
                    Just (r :: Double
r, g :: Double
g, b :: Double
b) ->
                        String -> Double -> Double -> Double -> t -> t
forall r. PrintfType r => String -> r
printf "\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" Double
r Double
g Double
b t
x