- += ( eelem "content"
- += (constA page >>> formatPage env )
- )
- >>>
- uniqueNamespacesFromDeclAndQNames
- )
- ) -<< ()
-
- returnA -< do let lastMod = toClockTime $ pageLastMod page
-
- case pageRevision page of
- Nothing -> foundTimeStamp lastMod
- Just rev -> foundEntity (strongETag $ show rev) lastMod
-
- outputXmlPage tree entityToXHTML
-
-
-entityToXHTML :: ArrowXml a => a XmlTree XmlTree
-entityToXHTML
- = eelem "/"
- += ( eelem "html"
- += sattr "xmlns" "http://www.w3.org/1999/xhtml"
- += ( eelem "head"
- += ( eelem "title"
- += getXPathTreesInDoc "/page/@site/text()"
- += txt " - "
- += getXPathTreesInDoc "/page/@name/text()"
- )
- += ( eelem "link"
- += sattr "rel" "stylesheet"
- += sattr "type" "text/css"
- += attr "href"
- ( getXPathTreesInDoc "/page/@styleSheet/text()" )
- )
- )
- += ( eelem "body"
- += ( eelem "div"
- += sattr "class" "header"
- )
- += ( eelem "div"
- += sattr "class" "center"
- += ( eelem "div"
- += sattr "class" "title"
- )
- += ( eelem "div"
- += sattr "class" "body"
- += getXPathTreesInDoc "/page/content/*"
- )
- )
- += ( eelem "div"
- += sattr "class" "footer"
- )
- += ( eelem "div"
- += sattr "class" "left side-bar"
- += ( eelem "div"
- += sattr "class" "content"
- )
- )
- += ( eelem "div"
- += sattr "class" "right side-bar"
- += ( eelem "div"
- += sattr "class" "content"
- )
- )
- )
- >>>
- uniqueNamespacesFromDeclAndQNames
- )
+ output $ UTF8.encodeString xmlStr
+
+render ∷ (ArrowXml (⇝), ArrowChoice (⇝), ArrowIO (⇝))
+ ⇒ Environment
+ → (PageName, MIMEType, Lazy.ByteString) ⇝ XmlTree
+render env
+ = proc (pName, pType, pBin)
+ → do pageBody ← listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
+ ⤙ (pName, pType, pBin)
+ ( eelem "/"
+ += ( eelem "renderResult"
+ += sattr "xmlns:xhtml" "http://www.w3.org/1999/xhtml"
+ += sattr "name" (T.unpack pName)
+ += constL pageBody
+ ⋙
+ uniqueNamespacesFromDeclAndQNames
+ ) ) ⤛ ()