Paragraph inlines
-> formatParagraph -< (baseURI, inlines)
+ Div attrs contents
+ -> formatElem "div" -< (baseURI, attrs, contents)
+ where
+ formatElem :: (ArrowXml a, ArrowChoice a) =>
+ String
+ -> a (URI, [Attribute], [BlockElement]) XmlTree
+ formatElem name
+ = proc (baseURI, attrs, contents)
+ -> ( eelem name
+ += ( arrL (fst . snd)
+ >>>
+ attrFromPair
+ )
+ += ( (arr fst &&& arrL (snd . snd))
+ >>>
+ formatBlock
+ )
+ ) -< (baseURI, (attrs, contents))
+
formatHeading :: ArrowXml a => a (Int, String) XmlTree
formatHeading
= proc (level, text)
- -> selem ("h" ++ show level) [txt text] -<< ()
+ -> mkelem ("h" ++ show level)
+ [ sattr "id" text ]
+ [ txt text ] -<< ()
formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, ListElement) XmlTree
Text text
-> mkText -< text
- Italic inlines
- -> ( eelem "i"
- += ( (arr fst &&& arrL snd)
- >>>
- formatInline
- )
- ) -< (baseURI, inlines)
+ Italic contents
+ -> formatElem "i" -< (baseURI, [], contents)
- Bold inlines
- -> ( eelem "b"
- += ( (arr fst &&& arrL snd)
- >>>
- formatInline
- )
- ) -< (baseURI, inlines)
+ Bold contents
+ -> formatElem "b" -< (baseURI, [], contents)
link@(PageLink _ _ _)
-> formatPageLink -< (baseURI, link)
+ link@(ExternalLink _ _)
+ -> formatExternalLink -< link
+
LineBreak attrs
- -> ( eelem "br"
- += (arrL id >>> attrFromPair)
- ) -< attrs
+ -> formatElem "br" -< (baseURI, attrs, [])
+
+ Span attrs contents
+ -> formatElem "span" -< (baseURI, attrs, contents)
+
+ Image attrs
+ -> formatElem "img" -< (baseURI, attrs, [])
+
+ Anchor attrs contents
+ -> formatElem "a" -< (baseURI, attrs, contents)
+ where
+ formatElem :: (ArrowXml a, ArrowChoice a) =>
+ String
+ -> a (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 a) => a (String, String) XmlTree
+= attr "href" (arr fst >>> mkText)
+= (arr snd >>> mkText)
) -< (href, label)
+
+
+formatExternalLink :: (ArrowXml a) => a InlineElement XmlTree
+formatExternalLink
+ = proc (ExternalLink uri text)
+ -> let href = uriToString id uri ""
+ label = fromMaybe href text
+ in
+ ( eelem "a"
+ += attr "href" (arr fst >>> mkText)
+ += (arr snd >>> mkText)
+ ) -< (href, label)