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
data Output = TTY
| LaTeX
| HTML
| CSS
| MIRC
deriving (Eq,Show)
hscolour :: Output
-> ColourPrefs
-> Bool
-> Bool
-> Bool
-> String
-> String
-> String
hscolour output pref anchor partial literate title
| literate = concatMap chunk . joinL . map lhsClassify . inlines
| otherwise = hscolour' output pref anchor partial title
where
chunk (Literate 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 Literate = Code {unL :: String} | Literate {unL :: String}
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 -> Literate
lhsClassify ('>':xs) = Code ('>':xs)
lhsClassify xs = Literate xs
joinL :: [Literate] -> [Literate]
joinL [] = []
joinL (Code c:Code c2:xs) = joinL (Code (c++c2):xs)
joinL (Literate c:Literate c2:xs) = joinL (Literate (c++c2):xs)
joinL (any:xs) = any: joinL xs