attachXHtmlNs -< tree
+formatElement :: (ArrowXml a, ArrowChoice a) => a (URI, Element) XmlTree
+formatElement
+ = proc (baseURI, elem)
+ -> case elem of
+ Block b -> formatBlock -< (baseURI, b)
+ Inline i -> formatInline -< (baseURI, i)
+
+
formatBlock :: (ArrowXml a, ArrowChoice a) => a (URI, BlockElement) XmlTree
formatBlock
= proc (baseURI, block)
HorizontalLine
-> eelem "hr" -< ()
- List list
+ list@(List _ _)
-> formatListElement -< (baseURI, list)
DefinitionList list
where
formatElem :: (ArrowXml a, ArrowChoice a) =>
String
- -> a (URI, [Attribute], [BlockElement]) XmlTree
+ -> a (URI, [Attribute], [Element]) XmlTree
formatElem name
= proc (baseURI, attrs, contents)
-> ( eelem name
)
+= ( (arr fst &&& arrL (snd . snd))
>>>
- formatBlock
+ formatElement
)
) -< (baseURI, (attrs, contents))
[ txt text ] -<< ()
-formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, ListElement) XmlTree
+formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, BlockElement) XmlTree
formatListElement
= proc (baseURI, list)
-> let tag = case listType list of
-> eelem "li"
+= ( (arr fst &&& arrL snd)
>>>
- formatListItem'
+ formatElement
) -< (baseURI, item)
- formatListItem' :: (ArrowXml a, ArrowChoice a) => a (URI, Either ListElement InlineElement) XmlTree
- formatListItem'
- = proc (baseURI, x)
- -> case x of
- Left nestedList -> formatListElement -< (baseURI, nestedList)
- Right inline -> formatInline -< (baseURI, inline )
-
formatDefinitionList :: (ArrowXml a, ArrowChoice a) => a (URI, [Definition]) XmlTree
formatDefinitionList