{-# LANGUAGE OverloadedStrings #-} module Html (generate) where import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Maybe (fromMaybe) import Text.Blaze (toValue, (!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Text (renderHtml) import Cheapskate (markdown, def) import Cheapskate.Html import Highlight import Types generate :: Maybe String -> String -> [Chunk] -> T.Text generate maybeCss name chunks = let lang = getLang name mergedProse = simplify chunks -- adjacent Prose combined to one prose body = H.preEscapedToHtml $ map (chunkToHtml lang) mergedProse doc = preface maybeCss name body in TL.toStrict $ renderHtml doc (<++>) :: T.Text -> T.Text -> T.Text (<++>) = T.append preface :: Maybe String -> String -> H.Html -> H.Html preface maybeCss fileName bodyHtml = let cssPath = fromMaybe "" maybeCss cssAttr = toValue cssPath includeCss = if cssPath /= "" then H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href cssAttr else H.toHtml T.empty in H.docTypeHtml $ do H.head $ do H.title $ H.toHtml fileName H.meta ! A.charset "UTF-8" includeCss H.body $ do bodyHtml simplify :: [Chunk] -> [Chunk] simplify [] = [] simplify lst = let (defs, ps) = span isDef lst (ps', rest) = break isDef ps mergeProse chunks = Prose $ T.concat $ map getProseText chunks in case ps' of [] -> defs ++ rest _ -> defs ++ [mergeProse ps'] ++ (simplify rest) chunkToHtml :: String -> Chunk -> H.Html chunkToHtml lang chunk = case chunk of Prose txt -> H.toHtml $ markdown def txt Def _ name parts -> let header = headerToHtml name htmlParts = H.preEscapedToHtml $ map (partToHtml lang) parts in H.pre $ H.code $ (header >> htmlParts) partToHtml :: String -> Part -> H.Html partToHtml lang part = case part of Code txt -> highlight lang txt Ref txt indent -> H.preEscapedToHtml (indent <++> "<< " <++> link <++> " >>\n") where link = " underscored <++> "\">" <++> slim <++> "" slim = T.strip txt underscored = underscore slim headerToHtml :: T.Text -> H.Html headerToHtml name = H.preEscapedToHtml $ "<< " <++> link <++> " >>=\n" where link = " underscored <++> "\" href=\"#" <++> underscored <++> "\">" <++> slim <++> "" slim = T.strip name underscored = underscore slim underscore :: T.Text -> T.Text underscore txt = T.pack $ concatMap (\c -> if c == ' ' then "_" else [c]) $ T.unpack txt