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

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

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

escapeLaTeX :: Bool -> String -> String
escapeLaTeX :: Bool -> [Char] -> [Char]
escapeLaTeX Bool
inline = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeLaTeXChar
  where escapeLaTeXChar :: Char -> [Char]
escapeLaTeXChar Char
'\\' = [Char]
"\\textbackslash{}"
        escapeLaTeXChar Char
'{'  = [Char]
"\\{"
        escapeLaTeXChar Char
'}'  = [Char]
"\\}"
        escapeLaTeXChar Char
'|'  = if Bool
inline
                                  then [Char]
"\\VerbBar{}" -- used in inline verbatim
                                  else [Char]
"|"
        escapeLaTeXChar 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] -> [Char]
formatLaTeXBlock FormatOptions
opts [SourceLine]
ls = [[Char]] -> [Char]
unlines
  [[Char]
"\\begin{Shaded}"
  ,[Char]
"\\begin{Highlighting}[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
   (if FormatOptions -> Bool
numberLines FormatOptions
opts
       then [Char]
"numbers=left," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            (if FormatOptions -> Int
startNumber FormatOptions
opts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                then [Char]
""
                else [Char]
",firstnumber=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (FormatOptions -> Int
startNumber FormatOptions
opts)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
","
       else [Char]
"") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
  ,Bool -> [SourceLine] -> [Char]
formatLaTeX Bool
False [SourceLine]
ls
  ,[Char]
"\\end{Highlighting}"
  ,[Char]
"\\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 -> [Char]
styleToLaTeX Style
f = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
  [ [Char]
"\\usepackage{color}"
  , [Char]
"\\usepackage{fancyvrb}"
  , [Char]
"\\newcommand{\\VerbBar}{|}"
  , [Char]
"\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}"
  , [Char]
"\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
  , [Char]
"% Add ',fontsize=\\small' for more characters per line"
  ] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
  (case Style -> Maybe Color
backgroundColor Style
f of
        Maybe Color
Nothing          -> [[Char]
"\\newenvironment{Shaded}{}{}"]
        Just (RGB Word8
r Word8
g Word8
b) -> [[Char]
"\\usepackage{framed}"
                            ,[Char] -> Word8 -> Word8 -> Word8 -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\definecolor{shadecolor}{RGB}{%d,%d,%d}" Word8
r Word8
g Word8
b
                            ,[Char]
"\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"])
  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (TokenType -> [Char]) -> [TokenType] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> [Char]
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 -> [Char]
macrodef Maybe Color
defaultcol [(TokenType, TokenStyle)]
tokstyles TokenType
tokt = [Char]
"\\newcommand{\\" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TokenType -> [Char]
forall a. Show a => a -> [Char]
show TokenType
tokt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                     [Char]
"}[1]{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
forall {t}. (PrintfArg t, PrintfType t) => t -> t
co ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
ul ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
bf ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
it ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall {t}. (PrintfArg t, PrintfType t) => t -> t
bg ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"{#1}") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
  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 :: [Char] -> [Char]
ul [Char]
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
                  then [Char]
"\\underline{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
                  else [Char]
x
        it :: [Char] -> [Char]
it [Char]
x = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
                  then [Char]
"\\textit{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
                  else [Char]
x
        bf :: [Char] -> [Char]
bf [Char]
x = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
                  then [Char]
"\\textbf{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
                  else [Char]
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) -> [Char] -> Double -> Double -> Double -> t -> t
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\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) -> [Char] -> Double -> Double -> Double -> t -> t
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" Double
r Double
g Double
b t
x