module Manual.Emit.XHTML where
import Manual.Structure
import Manual.Emit.Text
import Text.Pretty
import Text.XHtml.Strict hiding (header,title,style)
import qualified Text.XHtml.Strict as X
import Data.Char
render_manual_xhtml :: Manual -> String
render_manual_xhtml = showHtml . toHtml
instance HTML Manual where
toHtml man =
X.header (concatHtml [meta ! [httpequiv "Content-Type"
,content "text/html;charset=utf-8"]
, thetitle $ stringToHtml $ pretty $ mtitle $ header man
, X.style (primHtml $ style man) ! [thetype "text/css"]]) +++
(body $ concatHtml $ toHtml (header man) : toHtml (mcontents man) : map toHtml (sections man))
instance HTML Header where
toHtml head = concatHtml $
(h1 (toHtml $ mtitle head) ! intro_ban_class (mtitle head)) : map (\b -> (h2 $ toHtml b) ! intro_ban_class b) (banners head) ++ map toHtml (preamble head)
intro_ban_class :: Banner -> [HtmlAttr]
intro_ban_class = ban_class "intro_banner"
instance HTML Contents where
toHtml = paragraph . hcontents (1)
nbsp :: Html
nbsp = spaceHtml
hcontents :: Int -> Contents -> Html
hcontents i c =
case c of
Contents cs -> concatHtml $ map (hcontents $ i + 1) cs
Entry nums str unique ->
let sname = section_name nums str
in concatHtml $ replicate (3 * i) nbsp ++ [section_link sname unique, br]
section_title :: [Int] -> Banner -> String -> Html
section_title nums section unique =
(h2 $ (anchor $ stringToHtml (pretty_nums nums " ") +++ toHtml section) ! [name unique]) ! section_ban_class section
section_name :: [Int] -> String -> String
section_name nums section = pretty_nums nums " " ++ section
instance HTML Section where
toHtml sec = concatHtml $
section_title (number sec) (title sec) (unique sec) : map toHtml (stext sec) ++ map toHtml (subsections sec)
instance HTML Paragraph where
toHtml para =
paragraph (concatHtml $ map (html_inline (wrap para)) (ptext para)) ! [theclass $ pclass para]
instance HTML Banner where
toHtml ban =
concatHtml $ map (html_inline True) (btext ban)
section_ban_class :: Banner -> [HtmlAttr]
section_ban_class = ban_class "banner"
ban_class :: String -> Banner -> [HtmlAttr]
ban_class def ban = [theclass cls]
where
cls =
if null $ bclass ban
then def
else bclass ban
html_inline :: Bool -> Inline -> Html
html_inline wrap inline =
case inline of
IText str -> (if wrap then stringToHtml else literal_spaces . stringToHtmlString) str
ISectionLink text dest -> section_link text dest
IExternLink text dest -> extern_link text dest
ILiteral t -> primHtml t
literal_spaces :: String -> Html
literal_spaces = concatHtml . map literal_space
where
literal_space c =
case c of
' ' -> nbsp
'\t' -> concatHtml $ replicate 6 nbsp
'\n' -> br
_ -> primHtml [c]
section_link :: String -> URL -> Html
section_link text dest = toHtml $ hotlink ('#':dest) (stringToHtml text)
extern_link :: String -> URL -> Html
extern_link text dest = toHtml $ hotlink dest (stringToHtml text)