HsColour.hs

module Network.Salvia.Advanced.HsColour (
    hHighlightHaskell
  , hHsColour
  , hHsColourCustomStyle

  , defaultStyleSheet
  ) where

import Language.Haskell.HsColour.CSS

import Network.Salvia.Handlers.ExtensionDispatcher
import Network.Salvia.Handlers.File
import Network.Protocol.Http (setContentType, utf8)
import Network.Salvia.Httpd

hHighlightHaskell :: Handler () -> Handler () -> Handler ()
hHighlightHaskell highlighter = 
  hExtensionRouter [
    (Just "hs",  highlighter)
  , (Just "lhs", highlighter)
  , (Just "ag",  highlighter)
  ] 

hHsColour :: Handler ()
hHsColour = hHsColourCustomStyle (Left defaultStyleSheet)

-- Left means direct inclusion of stylesheet, right means link to external
-- stylesheet.

hHsColourCustomStyle :: Either String String -> Handler ()
hHsColourCustomStyle style = do
  sendStr (either id makeStyleLink style)
  hFileFilter (hscolour False True "")
  modResponse
    $ setContentType ("text/html") (Just utf8)

makeStyleLink :: String -> String
makeStyleLink css = "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ css ++ "\"></link>"

defaultStyleSheet :: String
defaultStyleSheet = filter (/=' ') $ concat [
    "<style>"
  , ".varop      { color : #960; font-weight : normal; }"
  , ".keyglyph   { color : #960; font-weight : normal; }"
  , ".definition { color : #005; font-weight : bold;   }"
  , ".varid      { color : #444; font-weight : normal; }"
  , ".keyword    { color : #000; font-weight : bold;   }"
  , ".comment    { color : #44f; font-weight : normal; }"
  , ".conid      { color : #000; font-weight : normal; }"
  , ".num        { color : #00a; font-weight : normal; }"
  , ".str        { color : #a00; font-weight : normal; }"
  , "</style>"
  , ""
  ]