{-# 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 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
$ 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 :: p -> p
ul p
x = if TokenStyle -> Bool
tokenUnderline TokenStyle
tokf
                  then p
"\\underline{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"}"
                  else p
x
        it :: p -> p
it p
x = if TokenStyle -> Bool
tokenItalic TokenStyle
tokf
                  then p
"\\textit{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"}"
                  else p
x
        bf :: p -> p
bf p
x = if TokenStyle -> Bool
tokenBold TokenStyle
tokf
                  then p
"\\textbf{" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
x p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"}"
                  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 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 (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 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