+ LineBreak attrs
+ -> formatElem "br" -< (baseURI, attrs, [])
+
+ Span attrs contents
+ -> formatElem "span" -< (baseURI, attrs, contents)
+
+ img@(Image _ _)
+ -> formatImage -< (baseURI, img)
+
+ Anchor attrs contents
+ -> formatElem "a" -< (baseURI, attrs, contents)
+
+ Input attrs
+ -> formatElem "input" -< (baseURI, attrs, [])
+
+ EmptyInline
+ -> none -< ()
+
+ _ -> arr (error . ("formatInline: unsupported InlineElement: " ++) . show) -< i
+ where
+ formatElem ∷ (ArrowXml (⇝), ArrowChoice (⇝)) ⇒
+ String
+ → (URI, [Attribute], [InlineElement]) ⇝ XmlTree
+ formatElem name
+ = proc (baseURI, attrs, contents)
+ → ( eelem name
+ += ( arrL (fst ∘ snd)
+ ⋙
+ attrFromPair
+ )
+ += ( (arr fst &&& arrL (snd . snd))
+ ⋙
+ formatInline
+ )
+ ) ⤙ (baseURI, (attrs, contents))
+
+attrFromPair ∷ ArrowXml (⇝) ⇒ Attribute ⇝ XmlTree
+attrFromPair = proc (T.unpack ∘ CS.original → name, T.unpack → value)
+ → attr name (txt value) ⤛ ()
+
+formatObjectLink ∷ ArrowXml (⇝) ⇒ (URI, InlineElement) ⇝ XmlTree
+formatObjectLink
+ = proc (baseURI, ObjectLink page text)
+ → let uri = mkObjectURI baseURI page
+ label = fromMaybe ("{" ⊕ page ⊕ "}") text
+ in
+ mkAnchor ⤙ (uri, label)
+
+formatPageLink ∷ ArrowXml (⇝) ⇒ (URI, InlineElement) ⇝ XmlTree