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
hscolour output pref anchor partial False =
hscolour' output pref anchor partial
hscolour output pref anchor partial True =
concatMap chunk . joinL . map lhsClassify . inlines
where
chunk (Literate c) = c
chunk (Code c) = hscolour' output pref anchor True c
hscolour' :: Output
-> ColourPrefs
-> Bool
-> Bool
-> 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 = HTML.hscolour pref anchor partial
hscolour' CSS _ anchor partial = CSS.hscolour anchor partial
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