-- | 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 -> Stringhscolour pref :: ColourPrefspref = concatMap :: (a -> [b]) -> [a] -> [b]concatMap (renderToken :: ColourPrefs -> (TokenType, String) -> StringrenderToken pref :: ColourPrefspref) (.) :: (b -> c) -> (a -> b) -> a -> c. tokenise :: String -> [(TokenType, String)]tokenise

top'n'tail :: String -> String -> String
top'n'tail :: String -> String -> Stringtop'n'tail title :: Stringtitle = (latexPrefix :: [Char] -> StringlatexPrefix title :: Stringtitle(++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. ((++) :: [a] -> [a] -> [a]++latexSuffix :: StringlatexSuffix)

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

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

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


-- | 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 :: Colourc) = ("\\textcolor{"(++) :: [a] -> [a] -> [a]++ latexColour :: Colour -> StringlatexColour c :: Charc (++) :: [a] -> [a] -> [a]++"}{", "}")
latexHighlight (Background c :: Colourc) = ("\\colorbox{"(++) :: [a] -> [a] -> [a]++ latexColour :: Colour -> StringlatexColour c :: Charc (++) :: [a] -> [a] -> [a]++"}{", "}")
latexHighlight Italic         = ("{\\it{}", "}")

-- | Translate a 'Colour' into a LaTeX colour name.
latexColour :: Colour -> String
latexColour :: Colour -> StringlatexColour 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 :: Colourc@(Rgb _ _ _) = latexColour :: Colour -> StringlatexColour (projectToBasicColour8 :: Colour -> ColourprojectToBasicColour8 c :: Charc)

-- | Generic LaTeX document preamble.
latexPrefix :: [Char] -> StringlatexPrefix title :: [Char]title = unlines :: [String] -> Stringunlines
    ["\\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{"(++) :: [a] -> [a] -> [a]++title :: Stringtitle(++) :: [a] -> [a] -> [a]++"}"
    ,"%% Generated by HsColour"
    ,"\\begin{document}"
    ,"\\maketitle"
    ,"\\noindent"
    ]

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