import Data.Char
import Data.List
import Data.Maybe
-import Network.URI
+import Network.URI hiding (fragment)
import Rakka.Page
import Rakka.Wiki
import Text.XML.HXT.Arrow.XmlArrow
formatElement :: (ArrowXml a, ArrowChoice a) => a (URI, Element) XmlTree
formatElement
- = proc (baseURI, elem)
- -> case elem of
+ = proc (baseURI, e)
+ -> case e of
Block b -> formatBlock -< (baseURI, b)
Inline i -> formatInline -< (baseURI, i)
EmptyBlock
-> none -< ()
+
+ _ -> arr (error . ("formatBlock: unsupported BlockElement: " ++) . show) -< block
where
formatElem :: (ArrowXml a, ArrowChoice a) =>
String
EmptyInline
-> none -< ()
+
+ _ -> arr (error . ("formatInline: unsupported InlineElement: " ++) . show) -< i
where
formatElem :: (ArrowXml a, ArrowChoice a) =>
String
(Just x, Just y) -> mkPageFragmentURI baseURI x y
(Just x, Nothing) -> mkPageURI baseURI x
(Nothing, Just y) -> mkFragmentURI y
+ _ -> undefined
href = uriToString id uri ""
dLabel = fromMaybe "" page ++ fromMaybe "" (fmap ('#':) fragment)
label = fromMaybe dLabel text
formatImage :: (ArrowXml a) => a (URI, InlineElement) XmlTree
formatImage = proc (baseURI, Image src alt)
-> let uri = case src of
- Left uri -> uri
+ Left u -> u
Right name -> mkObjectURI baseURI name
href = uriToString id uri ""
in