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

{-@ LIQUID "--totality" @-}

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 pref = concatMap (renderToken pref) . tokenise

top'n'tail :: String -> String -> String
top'n'tail title = (latexPrefix title++) . (++latexSuffix)

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

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

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


-- | Constructs the appropriate LaTeX macro for the given style.
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) = ("\\textcolor{"++ latexColour c ++"}{", "}")
latexHighlight (Background c) = ("\\colorbox{"++ latexColour c ++"}{", "}")
latexHighlight Italic         = ("{\\it{}", "}")

-- | Translate a 'Colour' into a LaTeX colour name.
{-@ latexColour :: c:Colour -> _ / [(1 - (isBasic c))] @-}
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@(Rgb _ _ _) = latexColour (projectToBasicColour8 c)

-- | Generic LaTeX document preamble.
latexPrefix title = 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{"++title++"}"
    ,"%% Generated by HsColour"
    ,"\\begin{document}"
    ,"\\maketitle"
    ,"\\noindent"
    ]

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