-- | This is a library which colourises Haskell code.
--   It currently has six output formats:
--
-- * ANSI terminal codes
--
-- * LaTeX macros
--
-- * HTML 3.2 with font tags
--
-- * HTML 4.01 with external CSS.
--
-- * XHTML 1.0 with internal CSS.
--
-- * mIRC chat client colour codes.
--
module Language.Haskell.HsColour (Output(..), ColourPrefs(..),
                                  hscolour) where

import Language.Haskell.HsColour.Colourise  (ColourPrefs(..))
import qualified Language.Haskell.HsColour.TTY        as TTY
import qualified Language.Haskell.HsColour.HTML       as HTML
import qualified Language.Haskell.HsColour.CSS        as CSS
import qualified Language.Haskell.HsColour.ACSS       as ACSS 
import qualified Language.Haskell.HsColour.InlineCSS  as ICSS
import qualified Language.Haskell.HsColour.LaTeX      as LaTeX
import qualified Language.Haskell.HsColour.MIRC       as MIRC
import List(mapAccumL, isPrefixOf)
import Maybe
import Language.Haskell.HsColour.Output
--import Debug.Trace

-- | Colourise Haskell source code with the given output format.
hscolour :: Output      -- ^ Output format.
         -> ColourPrefs -- ^ Colour preferences (for formats that support them).
         -> Bool        -- ^ Whether to include anchors.
         -> Bool        -- ^ Whether output document is partial or complete.
         -> String	-- ^ Title for output.
         -> Bool        -- ^ Whether input document is literate haskell or not
         -> String      -- ^ Haskell source code.
         -> String      -- ^ Coloured Haskell source code.
hscolour ::
  Output
  -> ColourPrefs
  -> Bool
  -> Bool
  -> String
  -> Bool
  -> String
  -> Stringhscolour output :: Outputoutput pref :: ColourPrefspref anchor :: Boolanchor partial :: Boolpartial title :: Stringtitle False =
        (if partial :: Boolpartial then id :: a -> aid else top'n'tail :: Output -> String -> String -> Stringtop'n'tail output :: Outputoutput title :: Stringtitle) (.) :: (b -> c) -> (a -> b) -> a -> c.
        hscolour' :: Output -> ColourPrefs -> Bool -> String -> Stringhscolour' output :: Outputoutput pref :: ColourPrefspref anchor :: Boolanchor
hscolour output :: Outputoutput pref :: ColourPrefspref anchor :: Boolanchor partial :: Boolpartial title :: Stringtitle True  =
        (if partial :: Boolpartial then id :: a -> aid else top'n'tail :: Output -> String -> String -> Stringtop'n'tail output :: Outputoutput title :: Stringtitle) (.) :: (b -> c) -> (a -> b) -> a -> c.
        concatMap :: (a -> [b]) -> [a] -> [b]concatMap chunk :: Lit -> Stringchunk (.) :: (b -> c) -> (a -> b) -> a -> c. joinL :: [Lit] -> [Lit]joinL (.) :: (b -> c) -> (a -> b) -> a -> c. classify :: [String] -> [Lit]classify (.) :: (b -> c) -> (a -> b) -> a -> c. inlines :: String -> [String]inlines
  where
    chunk :: Lit -> Stringchunk (Code c :: Stringc) = hscolour' :: Output -> ColourPrefs -> Bool -> String -> Stringhscolour' output :: Outputoutput pref :: ColourPrefspref anchor :: Boolanchor c :: Stringc
    chunk (Lit c :: Stringc)  = c :: Stringc

-- | The actual colourising worker, despatched on the chosen output format.
hscolour' :: Output      -- ^ Output format.
          -> ColourPrefs -- ^ Colour preferences (for formats that support them)
          -> Bool        -- ^ Whether to include anchors.
          -> String      -- ^ Haskell source code.
          -> String      -- ^ Coloured Haskell source code.
hscolour' :: Output -> ColourPrefs -> Bool -> String -> Stringhscolour' TTY       pref :: ColourPrefspref _      = hscolour :: ColourPrefs -> String -> StringTTY.hscolour     pref :: ColourPrefspref
hscolour' (TTYg tt :: TerminalTypett) pref :: ColourPrefspref _      = hscolourG :: TerminalType -> ColourPrefs -> String -> [Char]TTY.hscolourG tt :: TerminalTypett pref :: ColourPrefspref
hscolour' MIRC      pref :: ColourPrefspref _      = hscolour :: ColourPrefs -> String -> StringMIRC.hscolour    pref :: ColourPrefspref
hscolour' LaTeX     pref :: ColourPrefspref _      = hscolour :: ColourPrefs -> String -> StringLaTeX.hscolour   pref :: ColourPrefspref
hscolour' HTML      pref :: ColourPrefspref anchor :: Boolanchor = hscolour :: ColourPrefs -> Bool -> String -> StringHTML.hscolour    pref :: ColourPrefspref anchor :: Boolanchor
hscolour' CSS       _    anchor :: Boolanchor = hscolour :: Bool -> String -> StringCSS.hscolour          anchor :: Boolanchor
hscolour' ICSS      pref :: ColourPrefspref anchor :: Boolanchor = hscolour :: ColourPrefs -> Bool -> String -> StringICSS.hscolour    pref :: ColourPrefspref anchor :: Boolanchor
hscolour' ACSS      _    anchor :: Boolanchor = hscolour :: Bool -> String -> StringACSS.hscolour         anchor :: Boolanchor

-- | Choose the right headers\/footers, depending on the output format.
top'n'tail :: Output           -- ^ Output format
           -> String           -- ^ Title for output
           -> (String->String) -- ^ Output transformer
top'n'tail :: Output -> String -> String -> Stringtop'n'tail TTY   _     = id :: a -> aid
top'n'tail (TTYg _) _  = id :: a -> aid
top'n'tail MIRC  _     = id :: a -> aid
top'n'tail LaTeX title :: Stringtitle = top'n'tail :: String -> String -> StringLaTeX.top'n'tail title :: Stringtitle
top'n'tail HTML  title :: Stringtitle = top'n'tail :: String -> String -> StringHTML.top'n'tail title :: Stringtitle
top'n'tail CSS   title :: Stringtitle = top'n'tail :: String -> String -> StringCSS.top'n'tail  title :: Stringtitle
top'n'tail ICSS  title :: Stringtitle = top'n'tail :: String -> String -> StringICSS.top'n'tail title :: Stringtitle
top'n'tail ACSS  title :: Stringtitle = top'n'tail :: String -> String -> StringCSS.top'n'tail  title :: Stringtitle

-- | Separating literate files into code\/comment chunks.
data unL :: StringLit = Code :: String -> LitCode {unL :: Lit -> StringunL :: String} | Lit :: String -> LitLit {unL :: String} deriving (D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow)

-- Re-implementation of 'lines', for better efficiency (but decreased laziness).
-- Also, importantly, accepts non-standard DOS and Mac line ending characters.
-- And retains the trailing '\n' character in each resultant string.
inlines :: String -> [String]
inlines :: String -> [String]inlines s :: Strings = lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]lines' s :: [Char]s id :: a -> aid
  where
  lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]lines' []             acc :: [Char] -> [Char]acc = [acc :: [Char] -> [Char]acc [] :: [a][]]
  lines' ('\^M':'\n':s :: [Char]s) acc :: [Char] -> [Char]acc = acc :: [Char] -> [Char]acc ['\n'] (:) :: a -> [a] -> [a]: lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]lines' s :: [Char]s id :: a -> aid	-- DOS
--lines' ('\^M':s)      acc = acc ['\n'] : lines' s id	-- MacOS
  lines' ('\n':s :: [Char]s)       acc :: [Char] -> [Char]acc = acc :: [Char] -> [Char]acc ['\n'] (:) :: a -> [a] -> [a]: lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]lines' s :: [Char]s id :: a -> aid	-- Unix
  lines' (c :: Charc:s :: [Char]s)          acc :: [Char] -> [Char]acc = lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]lines' s :: [Char]s (acc :: [Char] -> [Char]acc (.) :: (b -> c) -> (a -> b) -> a -> c. (c :: Stringc(:) :: a -> [a] -> [a]:))


-- | The code for classify is largely stolen from Language.Preprocessor.Unlit.
classify ::  [String] -> [Lit]
classify :: [String] -> [Lit]classify []             = [] :: [a][]
classify (x :: Stringx:xs :: [String]xs) | "\\begin{code}"isPrefixOf :: Eq a => [a] -> [a] -> Bool`isPrefixOf`x :: Stringx
                        = Lit :: String -> LitLit x :: Stringx(:) :: a -> [a] -> [a]: allProg :: [[Char]] -> [Lit]allProg xs :: [String]xs
   where allProg :: [[Char]] -> [Lit]allProg []     = [] :: [a][]  -- Should give an error message,
                              -- but I have no good position information.
         allProg (x :: [Char]x:xs :: [[Char]]xs) | "\\end{code}"isPrefixOf :: Eq a => [a] -> [a] -> Bool`isPrefixOf`x :: Stringx
                        = Lit :: String -> LitLit x :: Stringx(:) :: a -> [a] -> [a]: classify :: [String] -> [Lit]classify xs :: [String]xs
         allProg (x :: [Char]x:xs :: [[Char]]xs) = Code :: String -> LitCode x :: Stringx(:) :: a -> [a] -> [a]: allProg :: [[Char]] -> [Lit]allProg xs :: [String]xs
classify (('>':x :: [Char]x):xs :: [String]xs)   = Code :: String -> LitCode ('>'(:) :: a -> [a] -> [a]:x :: Stringx) (:) :: a -> [a] -> [a]: classify :: [String] -> [Lit]classify xs :: [String]xs
classify (x :: Stringx:xs :: [String]xs)         = Lit :: String -> LitLit x :: Stringx(:) :: a -> [a] -> [a]: classify :: [String] -> [Lit]classify xs :: [String]xs

-- | Join up chunks of code\/comment that are next to each other.
joinL :: [Lit] -> [Lit]
joinL :: [Lit] -> [Lit]joinL []                  = [] :: [a][]
joinL (Code c :: Stringc:Code c2 :: Stringc2:xs :: [Lit]xs) = joinL :: [Lit] -> [Lit]joinL (Code :: String -> LitCode (c :: Stringc(++) :: [a] -> [a] -> [a]++c2 :: Stringc2)(:) :: a -> [a] -> [a]:xs :: [String]xs)
joinL (Lit c :: Stringc :Lit c2 :: Stringc2 :xs :: [Lit]xs) = joinL :: [Lit] -> [Lit]joinL (Lit :: String -> LitLit  (c :: Stringc(++) :: [a] -> [a] -> [a]++c2 :: Stringc2)(:) :: a -> [a] -> [a]:xs :: [String]xs)
joinL (any :: Litany:xs :: [Lit]xs)            = any :: Litany(:) :: a -> [a] -> [a]: joinL :: [Lit] -> [Lit]joinL xs :: [String]xs