+makePageLinkList :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Storage
+ -> SystemConfig
+ -> InterpTable
+ -> a XmlTree [PageName]
+makePageLinkList sto sysConf interpTable
+ = proc tree
+ -> do wiki <- wikifyPage interpTable -< tree
+ pName <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
+ interpreted <- interpretCommands sto sysConf interpTable
+ -< (pName, Just tree, Just wiki, wiki)
+ returnA -< concatMap extractFromBlock interpreted
+ where
+ extractFromElem :: Element -> [PageName]
+ extractFromElem (Block b) = extractFromBlock b
+ extractFromElem (Inline i) = extractFromInline i
+
+ extractFromBlock :: BlockElement -> [PageName]
+ extractFromBlock (List _ items) = concatMap extractFromListItem items
+ extractFromBlock (DefinitionList defs) = concatMap extractFromDefinition defs
+ extractFromBlock (Preformatted inlines) = concatMap extractFromInline inlines
+ extractFromBlock (Paragraph inlines) = concatMap extractFromInline inlines
+ extractFromBlock (Div _ elems) = concatMap extractFromElem elems
+ extractFromBlock _ = []
+
+ extractFromInline :: InlineElement -> [PageName]
+ extractFromInline (Italic inlines) = concatMap extractFromInline inlines
+ extractFromInline (Bold inlines) = concatMap extractFromInline inlines
+ extractFromInline (Span _ inlines) = concatMap extractFromInline inlines
+ extractFromInline (PageLink (Just name) _ _) = [name]
+ extractFromInline _ = []
+
+ extractFromListItem :: ListItem -> [PageName]
+ extractFromListItem = concatMap extractFromElem
+
+ extractFromDefinition :: Definition -> [PageName]
+ extractFromDefinition (Definition term desc)
+ = concatMap extractFromInline term
+ ++
+ concatMap extractFromInline desc
+
+