-- | Formats Haskell source code using LaTeX macros.
module Language.Haskell.HsColour.LaTeX (hscolour, top'n'tail) where

import Language.Haskell.HsColour.Classify as Classify
import Language.Haskell.HsColour.Colourise
import Language.Haskell.HsColour.General

-- | Formats Haskell source code as a complete LaTeX document.
hscolour :: ColourPrefs -- ^ Colour preferences.
         -> String      -- ^ Haskell source code.
         -> String      -- ^ A LaTeX document\/fragment containing the coloured 
                        --   Haskell source code.
hscolour :: ColourPrefs -> String -> String
hscolour ColourPrefs
pref = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
pref) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(TokenType, String)]
tokenise

top'n'tail :: String -> String -> String
top'n'tail :: String -> String -> String
top'n'tail String
title = (String -> String
latexPrefix String
titleforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
latexSuffix)

-- | Wrap each lexeme in the appropriate LaTeX macro.
--   TODO: filter dangerous characters like "{}_$"
renderToken :: ColourPrefs -> (TokenType,String) -> String
renderToken :: ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
pref (TokenType
Space,String
text) = String -> String
filterSpace String
text
renderToken ColourPrefs
pref (TokenType
cls,String
text)   =
  let symb :: String
symb = case TokenType
cls of
              TokenType
String -> String
"``" forall a. [a] -> [a] -> [a]
++ (forall a. Eq a => a -> [a] -> [a]
dropFirst Char
'\"' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
dropLast Char
'\"' forall a b. (a -> b) -> a -> b
$ String
text) forall a. [a] -> [a] -> [a]
++ String
"''"
              TokenType
_      -> String
text
      style :: [Highlight]
style = ColourPrefs -> TokenType -> [Highlight]
colourise ColourPrefs
pref TokenType
cls
      ([String]
pre, [String]
post) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Highlight -> (String, String)
latexHighlight [Highlight]
style
  in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
pre forall a. [a] -> [a] -> [a]
++ String -> String
filterSpecial String
symb forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
post

-- | Filter white space characters.
filterSpace :: String
            -> String
filterSpace :: String -> String
filterSpace (Char
'\n':String
ss) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'\\'forall a. a -> [a] -> [a]
:(String -> String
filterSpace String
ss)
filterSpace (Char
' ':String
ss)  = String
"\\hsspace "forall a. [a] -> [a] -> [a]
++(String -> String
filterSpace String
ss)
filterSpace (Char
'\t':String
ss) = String
"\\hstab "forall a. [a] -> [a] -> [a]
++(String -> String
filterSpace String
ss)
filterSpace (Char
c:String
ss)    = Char
cforall a. a -> [a] -> [a]
:(String -> String
filterSpace String
ss)
filterSpace []        = []

-- | Filters the characters "#$%&~_^\{}" which are special
--   in LaTeX.
filterSpecial :: String  -- ^ The string to filter. 
              -> String  -- ^ The LaTeX-safe string.
filterSpecial :: String -> String
filterSpecial (Char
'#':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'#'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'$':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'$'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'%':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'%'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'&':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'&'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'~':String
cs)  = String
"\\tilde{ }"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'_':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'_'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'^':String
cs)  = String
"\\ensuremath{\\hat{ }}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'\\':String
cs) = String
"$\\backslash$"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'{':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'{'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'}':String
cs)  = Char
'\\'forall a. a -> [a] -> [a]
:Char
'}'forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial (Char
'|':String
cs)  = String
"\\ensuremath{|}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'<':Char
'-':String
cs)  = String
"\\ensuremath{\\leftarrow}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'<':String
cs)  = String
"\\ensuremath{\\langle}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'-':Char
'>':String
cs)  = String
"\\ensuremath{\\rightarrow}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
'>':String
cs)  = String
"\\ensuremath{\\rangle}"forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (Char
c:String
cs)    = Char
cforall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial []        = []


-- | Constructs the appropriate LaTeX macro for the given style.
latexHighlight :: Highlight -> (String, String)
latexHighlight :: Highlight -> (String, String)
latexHighlight Highlight
Normal         = (String
"{\\rm{}", String
"}")
latexHighlight Highlight
Bold           = (String
"{\\bf{}", String
"}")
latexHighlight Highlight
Dim            = (String
"", String
"")
latexHighlight Highlight
Underscore     = (String
"\\underline{", String
"}")
latexHighlight Highlight
Blink          = (String
"", String
"")
latexHighlight Highlight
ReverseVideo   = (String
"", String
"")
latexHighlight Highlight
Concealed      = (String
"\\conceal{", String
"}")
latexHighlight (Foreground Colour
c) = (String
"\\textcolor{"forall a. [a] -> [a] -> [a]
++ Colour -> String
latexColour Colour
c forall a. [a] -> [a] -> [a]
++String
"}{", String
"}")
latexHighlight (Background Colour
c) = (String
"\\colorbox{"forall a. [a] -> [a] -> [a]
++ Colour -> String
latexColour Colour
c forall a. [a] -> [a] -> [a]
++String
"}{", String
"}")
latexHighlight Highlight
Italic         = (String
"{\\it{}", String
"}")

-- | Translate a 'Colour' into a LaTeX colour name.
latexColour :: Colour -> String
latexColour :: Colour -> String
latexColour Colour
Black   = String
"black"
latexColour Colour
Red     = String
"red"
latexColour Colour
Green   = String
"green"
latexColour Colour
Yellow  = String
"yellow"
latexColour Colour
Blue    = String
"blue"
latexColour Colour
Magenta = String
"magenta"
latexColour Colour
Cyan    = String
"cyan"
latexColour Colour
White   = String
"white"
-- | TODO: How are these properly encoded in Latex?
latexColour c :: Colour
c@(Rgb Word8
_ Word8
_ Word8
_) = Colour -> String
latexColour (Colour -> Colour
projectToBasicColour8 Colour
c)

-- | Generic LaTeX document preamble.
latexPrefix :: String -> String
latexPrefix String
title = [String] -> String
unlines
    [String
"\\documentclass[a4paper, 12pt]{article}"
    ,String
"\\usepackage[usenames]{color}"
    ,String
"\\usepackage{hyperref}"
    ,String
"\\newsavebox{\\spaceb}"
    ,String
"\\newsavebox{\\tabb}"
    ,String
"\\savebox{\\spaceb}[1ex]{~}"
    ,String
"\\savebox{\\tabb}[4ex]{~}"
    ,String
"\\newcommand{\\hsspace}{\\usebox{\\spaceb}}"
    ,String
"\\newcommand{\\hstab}{\\usebox{\\tabb}}"
    ,String
"\\newcommand{\\conceal}[1]{}"
    ,String
"\\title{"forall a. [a] -> [a] -> [a]
++String
titleforall a. [a] -> [a] -> [a]
++String
"}"
    ,String
"%% Generated by HsColour"
    ,String
"\\begin{document}"
    ,String
"\\maketitle"
    ,String
"\\noindent"
    ]

-- | Generic LaTeX document postamble.
latexSuffix :: String
latexSuffix = [String] -> String
unlines
    [String
""
    ,String
"\\end{document}"
    ]