module Network.Salvia.Handler.HsColour
( hHighlightHaskell
, hHsColour
, hHsColourCustomStyle
, defaultStyleSheet
)
where
import Control.Monad.Trans
import Data.List
import Data.Record.Label
import Language.Haskell.HsColour.CSS
import Network.Protocol.Http
import Network.Salvia.Interface
import Network.Salvia.Handlers
hHighlightHaskell :: HttpM Request m => m a -> m a -> m a
hHighlightHaskell highlighter =
hExtensionRouter
[ (Just "hs", highlighter)
, (Just "lhs", highlighter)
, (Just "ag", highlighter)
]
hHsColour :: (SendM m, HttpM Response m, MonadIO m) => FilePath -> m ()
hHsColour = hHsColourCustomStyle (Left defaultStyleSheet)
hHsColourCustomStyle :: (SendM m, HttpM Response m, MonadIO m) => Either String String -> FilePath -> m ()
hHsColourCustomStyle style file =
do send (either id makeStyleLink style)
hFileResourceFilter (hscolour True) file
response (contentType =: Just ("text/html", Just "utf-8"))
makeStyleLink :: String -> String
makeStyleLink css = "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ css ++ "\"></link>"
defaultStyleSheet :: String
defaultStyleSheet = filter (/=' ') $ intercalate "\n"
[ "<style>"
, ".hs-varop { color : #960; font-weight : normal; }"
, ".hs-keyglyph { color : #960; font-weight : normal; }"
, ".hs-definition { color : #005; font-weight : bold; }"
, ".hs-varid { color : #444; font-weight : normal; }"
, ".hs-keyword { color : #000; font-weight : bold; }"
, ".hs-comment { color : #44f; font-weight : normal; }"
, ".hs-conid { color : #000; font-weight : normal; }"
, ".hs-num { color : #00a; font-weight : normal; }"
, ".hs-str { color : #a00; font-weight : normal; }"
, "</style>"
, ""
]