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.LaTeX as LaTeX
import qualified Language.Haskell.HsColour.MIRC as MIRC
import Data.List(mapAccumL, isPrefixOf)
import Data.Maybe
import Language.Haskell.HsColour.Output
import Language.Haskell.HsColour.Options (Literate(..))
import Debug.Trace
hscolour :: Output
-> ColourPrefs
-> Bool
-> Bool
-> Literate
-> String
-> String
-> String
hscolour output pref anchor partial literate title =
case literate of
NoLit -> hscolour' output pref anchor partial title
Bird -> literateHandler (map lhsClassify)
TeX -> literateHandler (snd . mapAccumL decideTypeOfLine False)
where
literateHandler f = concatMap chunk . joinL . f . inlines
chunk (Lit c) = c
chunk (Code c) = hscolour' output pref anchor True title c
hscolour' :: Output
-> ColourPrefs
-> Bool
-> Bool
-> String
-> String
-> String
hscolour' TTY pref _ _ _ = TTY.hscolour pref
hscolour' MIRC pref _ _ _ = MIRC.hscolour pref
hscolour' LaTeX pref _ partial _ = LaTeX.hscolour pref partial
hscolour' HTML pref anchor partial top = HTML.hscolour pref anchor partial top
hscolour' CSS _ anchor partial top = CSS.hscolour anchor partial top
data Lit = Code {unL :: String} | Lit {unL :: String} deriving (Show)
inlines :: String -> [String]
inlines s = lines' s id
where
lines' [] acc = [acc []]
lines' ('\^M':'\n':s) acc = acc ['\n'] : lines' s id
lines' ('\n':s) acc = acc ['\n'] : lines' s id
lines' (c:s) acc = lines' s (acc . (c:))
lhsClassify :: String -> Lit
lhsClassify ('>':xs) = Code ('>':xs)
lhsClassify xs = Lit xs
decideTypeOfLine texStyle current_line
| isPrefix "\\begin{code}" = codeLine
| texStyle = if not is_end then codeLine else (False, Code (current_line ))
| otherwise = (False, Lit current_line)
where isPrefix = flip isPrefixOf current_line
codeLine = (True, Code (current_line))
is_end = isPrefix "\\end{code}"
joinL :: [Lit] -> [Lit]
joinL [] = []
joinL (Code c:Code c2:xs) = joinL (Code (c++c2):xs)
joinL (Lit c :Lit c2 :xs) = joinL (Lit (c++c2):xs)
joinL (any:xs) = any: joinL xs