X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FWiki%2FEngine.hs;h=90ed666a25db4da0ca9134a4e73b64b154fcc2ef;hp=910ef15f318a2f3222443074a84d9de313ee29ec;hb=7dc6971beb8a9c9fc36a7275d03abf1f1f7c25e5;hpb=23977989ef4be7316b1c2c3f709ca1e8e6bb7f84

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 910ef15..90ed666 100644
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -2,8 +2,9 @@ module Rakka.Wiki.Engine
     ( InterpTable
     , makeMainXHTML
     , makeSubXHTML
-    , makeDraft
     , makePreviewXHTML
+    , makePageLinkList
+    , makeDraft
     )
     where
 
@@ -390,6 +391,48 @@ makeDraft interpTable
       addInlineCmdText doc (InlineCommand _ _ inlines) = mapM_ (addInlineText doc) inlines
 
 
+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
+
+
 wikifyParseError :: Arrow a => a ParseError WikiPage
 wikifyParseError = proc err
                  -> returnA -< [Div [("class", "error")]