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 Data.List(mapAccumL, isPrefixOf)
import Data.Maybe
import Language.Haskell.HsColour.Output
hscolour :: Output
-> ColourPrefs
-> Bool
-> Bool
-> String
-> Bool
-> String
-> String
hscolour output pref anchor partial title False =
(if partial then id else top'n'tail output title) .
hscolour' output pref anchor
hscolour output pref anchor partial title True =
(if partial then id else top'n'tail output title) .
concatMap chunk . joinL . classify . inlines
where
chunk (Code c) = hscolour' output pref anchor c
chunk (Lit c) = c
hscolour' :: Output
-> ColourPrefs
-> Bool
-> String
-> String
hscolour' TTY pref _ = TTY.hscolour pref
hscolour' (TTYg tt) pref _ = TTY.hscolourG tt pref
hscolour' MIRC pref _ = MIRC.hscolour pref
hscolour' LaTeX pref _ = LaTeX.hscolour pref
hscolour' HTML pref anchor = HTML.hscolour pref anchor
hscolour' CSS _ anchor = CSS.hscolour anchor
hscolour' ICSS pref anchor = ICSS.hscolour pref anchor
hscolour' ACSS _ anchor = ACSS.hscolour anchor
top'n'tail :: Output
-> String
-> (String->String)
top'n'tail TTY _ = id
top'n'tail (TTYg _) _ = id
top'n'tail MIRC _ = id
top'n'tail LaTeX title = LaTeX.top'n'tail title
top'n'tail HTML title = HTML.top'n'tail title
top'n'tail CSS title = CSS.top'n'tail title
top'n'tail ICSS title = ICSS.top'n'tail title
top'n'tail ACSS title = CSS.top'n'tail title
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:))
classify :: [String] -> [Lit]
classify [] = []
classify (x:xs) | "\\begin{code}"`isPrefixOf`x
= Lit x: allProg xs
where allProg [] = []
allProg (x:xs) | "\\end{code}"`isPrefixOf`x
= Lit x: classify xs
allProg (x:xs) = Code x: allProg xs
classify (('>':x):xs) = Code ('>':x) : classify xs
classify (x:xs) = Lit x: classify xs
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