Language/Haskell/HsColour.hs
--- | This is a library which colourises Haskell code.
--- It currently has five output formats:
---
--- * ANSI terminal codes
---
--- * LaTeX macros
---
--- * HTML with font tags
---
--- * HTML with CSS.
---
--- * mIRC chat client colour codes.
---
+-- | This is a library which colourises Haskell code.
+-- It currently has five output formats:
+--
+-- * ANSI terminal codes
+--
+-- * LaTeX macros
+--
+-- * HTML with font tags
+--
+-- * HTML with 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.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
-
--- | 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.
- -> Literate -- ^ Whether input document is literate haskell or not
- -> String -- ^ Title for output.
- -> String -- ^ Haskell source code.
- -> String -- ^ Coloured Haskell source code.
-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 -- ^ 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.
- -> String -- ^ Haskell source code.
- -> String -- ^ Coloured Haskell source code.
-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
-
--- | Separating literate files into code\/comment chunks.
-data Lit = Code {unL :: String} | Lit {unL :: String} deriving (Show)
-
--- 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 s = lines' s id
- where
- lines' [] acc = [acc []]
- lines' ('\^M':'\n':s) acc = acc ['\n'] : lines' s id -- DOS
---lines' ('\^M':s) acc = acc ['\n'] : lines' s id -- MacOS
- lines' ('\n':s) acc = acc ['\n'] : lines' s id -- Unix
- lines' (c:s) acc = lines' s (acc . (c:))
-
--- Note, I just pass the > symbol to the colouriser, which assumes that
--- it's token based and not parse-based!!!
-lhsClassify :: String -> Lit
-lhsClassify ('>':xs) = Code ('>':xs)
-lhsClassify xs = Lit xs
-
--- texstyle is a bool indicating whether we are currently inside a code block
-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
-
+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.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
+import Language.Haskell.HsColour.Options (Literate(..))
+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.
+ -> Literate -- ^ Whether input document is literate haskell or not
+ -> String -- ^ Title for output.
+ -> String -- ^ Haskell source code.
+ -> String -- ^ Coloured Haskell source code.
+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 -- ^ 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.
+ -> String -- ^ Haskell source code.
+ -> String -- ^ Coloured Haskell source code.
+hscolour' TTY pref _ _ _ = TTY.hscolour pref
+hscolour' MIRC pref _ _ _ = MIRC.hscolour pref
+hscolour' LaTeX pref _ partial _ = LaTeX.hscolour pref partial
+hscolour' HTML pref anch partial top = HTML.hscolour pref anch partial top
+hscolour' CSS _ anch partial top = CSS.hscolour anch partial top
+hscolour' ICSS pref anch partial top = ICSS.hscolour pref anch partial top
+
+-- | Separating literate files into code\/comment chunks.
+data Lit = Code {unL :: String} | Lit {unL :: String} deriving (Show)
+
+-- 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 s = lines' s id
+ where
+ lines' [] acc = [acc []]
+ lines' ('\^M':'\n':s) acc = acc ['\n'] : lines' s id -- DOS
+--lines' ('\^M':s) acc = acc ['\n'] : lines' s id -- MacOS
+ lines' ('\n':s) acc = acc ['\n'] : lines' s id -- Unix
+ lines' (c:s) acc = lines' s (acc . (c:))
+
+-- Note, I just pass the > symbol to the colouriser, which assumes that
+-- it's token based and not parse-based!!!
+lhsClassify :: String -> Lit
+lhsClassify ('>':xs) = Code ('>':xs)
+lhsClassify xs = Lit xs
+
+-- texstyle is a bool indicating whether we are currently inside a code block
+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
+
