-- | 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 pref :: ColourPrefs
pref = ((TokenType, String) -> String) -> [(TokenType, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
pref) ([(TokenType, String)] -> String)
-> (String -> [(TokenType, String)]) -> String -> String
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 title :: String
title = (String -> String
latexPrefix String
titleString -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
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 pref :: ColourPrefs
pref (Space,text :: String
text) = String -> String
filterSpace String
text
renderToken pref :: ColourPrefs
pref (cls :: TokenType
cls,text :: String
text)   =
  let symb :: String
symb = case TokenType
cls of
              String -> "``" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
dropFirst '\"' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
dropLast '\"' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
text) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "''"
              _      -> String
text
      style :: [Highlight]
style = ColourPrefs -> TokenType -> [Highlight]
colourise ColourPrefs
pref TokenType
cls
      (pre :: [String]
pre, post :: [String]
post) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, String)] -> ([String], [String]))
-> [(String, String)] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (Highlight -> (String, String))
-> [Highlight] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map Highlight -> (String, String)
latexHighlight [Highlight]
style
  in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
filterSpecial String
symb String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
post

-- | Filter white space characters.
filterSpace :: String
            -> String
filterSpace :: String -> String
filterSpace ('\n':ss :: String
ss) = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpace String
ss)
filterSpace (' ':ss :: String
ss)  = "\\hsspace "String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpace String
ss)
filterSpace ('\t':ss :: String
ss) = "\\hstab "String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpace String
ss)
filterSpace (c :: Char
c:ss :: String
ss)    = Char
cChar -> String -> String
forall 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 ('#':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'#'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('$':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'$'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('%':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'%'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('&':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'&'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('~':cs :: String
cs)  = "\\tilde{ }"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('_':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'_'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('^':cs :: String
cs)  = "\\ensuremath{\\hat{ }}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('\\':cs :: String
cs) = "$\\backslash$"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('{':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'{'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('}':cs :: String
cs)  = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'}'Char -> String -> String
forall a. a -> [a] -> [a]
:(String -> String
filterSpecial String
cs)
filterSpecial ('|':cs :: String
cs)  = "\\ensuremath{|}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('<':'-':cs :: String
cs)  = "\\ensuremath{\\leftarrow}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('<':cs :: String
cs)  = "\\ensuremath{\\langle}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('-':'>':cs :: String
cs)  = "\\ensuremath{\\rightarrow}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial ('>':cs :: String
cs)  = "\\ensuremath{\\rangle}"String -> String -> String
forall a. [a] -> [a] -> [a]
++(String -> String
filterSpecial String
cs)
filterSpecial (c :: Char
c:cs :: String
cs)    = Char
cChar -> String -> String
forall 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 Normal         = ("{\\rm{}", "}")
latexHighlight Bold           = ("{\\bf{}", "}")
latexHighlight Dim            = ("", "")
latexHighlight Underscore     = ("\\underline{", "}")
latexHighlight Blink          = ("", "")
latexHighlight ReverseVideo   = ("", "")
latexHighlight Concealed      = ("\\conceal{", "}")
latexHighlight (Foreground c :: Colour
c) = ("\\textcolor{"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Colour -> String
latexColour Colour
c String -> String -> String
forall a. [a] -> [a] -> [a]
++"}{", "}")
latexHighlight (Background c :: Colour
c) = ("\\colorbox{"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Colour -> String
latexColour Colour
c String -> String -> String
forall a. [a] -> [a] -> [a]
++"}{", "}")
latexHighlight Italic         = ("{\\it{}", "}")

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

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

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