{- |
   Module      : Text.Highlighting.Kate.Format.LaTeX
   Copyright   : Copyright (C) 2008-2011 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Formatters that convert a list of annotated source lines to LaTeX.
-}

module Text.Highlighting.Kate.Format.LaTeX (
         formatLaTeXInline, formatLaTeXBlock, styleToLaTeX
         ) where
import Text.Highlighting.Kate.Types
import Text.Printf
import Data.List (intercalate)
import Control.Monad (mplus)
import Data.Char (isSpace)

formatLaTeX :: Bool -> [SourceLine] -> String
formatLaTeX :: Bool -> [SourceLine] -> String
formatLaTeX inline :: Bool
inline = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String)
-> ([SourceLine] -> [String]) -> [SourceLine] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> String) -> [SourceLine] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> SourceLine -> String
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] -> String
formatLaTeXInline :: FormatOptions -> [SourceLine] -> String
formatLaTeXInline _opts :: FormatOptions
_opts ls :: [SourceLine]
ls = "\\VERB|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> [SourceLine] -> String
formatLaTeX Bool
True [SourceLine]
ls String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|"

sourceLineToLaTeX :: Bool -> SourceLine -> String
sourceLineToLaTeX :: Bool -> SourceLine -> String
sourceLineToLaTeX inline :: Bool
inline contents :: SourceLine
contents = (Token -> String) -> SourceLine -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Token -> String
tokenToLaTeX Bool
inline) SourceLine
contents

tokenToLaTeX :: Bool -> Token -> String
tokenToLaTeX :: Bool -> Token -> String
tokenToLaTeX inline :: Bool
inline (NormalTok, txt :: String
txt) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
txt = Bool -> String -> String
escapeLaTeX Bool
inline String
txt
tokenToLaTeX inline :: Bool
inline (toktype :: TokenType
toktype, txt :: String
txt)   = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:(TokenType -> String
forall a. Show a => a -> String
show TokenType
toktype String -> String -> String
forall a. [a] -> [a] -> [a]
++ "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String
escapeLaTeX Bool
inline String
txt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}")

escapeLaTeX :: Bool -> String -> String
escapeLaTeX :: Bool -> String -> String
escapeLaTeX inline :: Bool
inline = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeLaTeXChar
  where escapeLaTeXChar :: Char -> String
escapeLaTeXChar '\\' = "\\textbackslash{}"
        escapeLaTeXChar '{'  = "\\{"
        escapeLaTeXChar '}'  = "\\}"
        escapeLaTeXChar '|'  = if Bool
inline
                                  then "\\VerbBar{}" -- used in inline verbatim
                                  else "|"
        escapeLaTeXChar x :: Char
x    = [Char
x]

-- 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] -> String
formatLaTeXBlock :: FormatOptions -> [SourceLine] -> String
formatLaTeXBlock opts :: FormatOptions
opts ls :: [SourceLine]
ls = [String] -> String
unlines
  ["\\begin{Shaded}"
  ,"\\begin{Highlighting}[" String -> String -> String
forall a. [a] -> [a] -> [a]
++
   (if FormatOptions -> Bool
numberLines FormatOptions
opts
       then "numbers=left," String -> String -> String
forall a. [a] -> [a] -> [a]
++
            (if FormatOptions -> Int
startNumber FormatOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                then ""
                else ",firstnumber=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (FormatOptions -> Int
startNumber FormatOptions
opts)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ","
       else "") String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]"
  ,Bool -> [SourceLine] -> String
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 -> String
styleToLaTeX :: Style -> String
styleToLaTeX f :: Style
f = [String] -> String
unlines ([String] -> String) -> [String] -> String
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"
  ] [String] -> [String] -> [String]
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 -> 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}}"])
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (TokenType -> String) -> [TokenType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> String
macrodef (Style -> Maybe Color
defaultColor Style
f) (Style -> [(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 -> String
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> String
macrodef defaultcol :: Maybe Color
defaultcol tokstyles :: [(TokenType, TokenStyle)]
tokstyles tokt :: TokenType
tokt = "\\newcommand{\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TokenType -> String
forall a. Show a => a -> String
show TokenType
tokt String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     "}[1]{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (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
ul (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bf (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
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}") String -> String -> String
forall 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 :: String -> String
ul x :: String
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
                  then "\\underline{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}"
                  else String
x
        it :: String -> String
it x :: String
x = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
                  then "\\textit{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}"
                  else String
x
        bf :: String -> String
bf x :: String
x = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
                  then "\\textbf{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}"
                  else String
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