+
+
+{-
+ <pageNotFound site="CieloNegro"
+ styleSheet="http://example.org/object/StyleSheet/Default"
+ name="Foo/Bar">
+
+ <pageTitle>
+ blah blah...
+ </pageTitle>
+
+ <sideBar>
+ <left>
+ blah blah...
+ </left>
+ <right>
+ blah blah...
+ </right>
+ </sideBar>
+ </pageNotFound>
+-}
+handlePageNotFound :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a PageName (Resource ())
+handlePageNotFound env
+ = proc name
+ -> do SiteName siteName <- getSysConfA sysConf (SiteName undefined) -< ()
+ BaseURI baseURI <- getSysConfA sysConf (BaseURI undefined) -< ()
+ StyleSheet cssName <- getSysConfA sysConf (StyleSheet undefined) -< ()
+
+ Just pageTitle <- getPageA (envStorage env) -< "PageTitle"
+ Just leftSideBar <- getPageA (envStorage env) -< "SideBar/Left"
+ Just rightSideBar <- getPageA (envStorage env) -< "SideBar/Right"
+
+ tree <- ( eelem "/"
+ += ( eelem "pageNotFound"
+ += sattr "site" siteName
+ += sattr "styleSheet" (uriToString id (mkObjectURI baseURI cssName) "")
+ += sattr "name" name
+
+ += ( eelem "pageTitle"
+ += ( (constA name &&& constA pageTitle)
+ >>>
+ formatSubPage env
+ )
+ )
+ += ( eelem "sideBar"
+ += ( eelem "left"
+ += ( (constA name &&& constA leftSideBar)
+ >>>
+ formatSubPage env
+ )
+ )
+ += ( eelem "right"
+ += ( (constA name &&& constA rightSideBar)
+ >>>
+ formatSubPage env
+ )
+ )
+ )
+ >>>
+ uniqueNamespacesFromDeclAndQNames
+ )
+ ) -<< ()
+
+ returnA -< do setStatus NotFound
+ outputXmlPage tree notFoundToXHTML
+ where
+ sysConf :: SystemConfig
+ sysConf = envSysConf env
+
+
+notFoundToXHTML :: ArrowXml a => a XmlTree XmlTree
+notFoundToXHTML
+ = eelem "/"
+ += ( eelem "html"
+ += sattr "xmlns" "http://www.w3.org/1999/xhtml"
+ += ( eelem "head"
+ += ( eelem "title"
+ += getXPathTreesInDoc "/pageNotFound/@site/text()"
+ += txt " - "
+ += getXPathTreesInDoc "/pageNotFound/@name/text()"
+ )
+ += ( eelem "link"
+ += sattr "rel" "stylesheet"
+ += sattr "type" "text/css"
+ += attr "href"
+ ( getXPathTreesInDoc "/pageNotFound/@styleSheet/text()" )
+ )
+ )
+ += ( eelem "body"
+ += ( eelem "div"
+ += sattr "class" "header"
+ )
+ += ( eelem "div"
+ += sattr "class" "center"
+ += ( eelem "div"
+ += sattr "class" "title"
+ += getXPathTreesInDoc "/pageNotFound/pageTitle/*"
+ )
+ += ( eelem "div"
+ += sattr "class" "body"
+ += txt "404 Not Found (FIXME)" -- FIXME
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "footer"
+ )
+ += ( eelem "div"
+ += sattr "class" "left sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += getXPathTreesInDoc "/pageNotFound/sideBar/left/*"
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "right sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += getXPathTreesInDoc "/pageNotFound/sideBar/right/*"
+ )
+ )
+ )
+ >>>
+ uniqueNamespacesFromDeclAndQNames
+ )