Farewell the dream of plug-in system... It's way too hard to implement nicely. Many...

[Rakka.git] / Rakka / Wiki / Interpreter / Outline.hs

diff --git a/Rakka/Wiki/Interpreter/Outline.hs b/Rakka/Wiki/Interpreter/Outline.hs
new file mode 100644 (file)
index 0000000..04554a6
--- /dev/null
+++ b/Rakka/Wiki/Interpreter/Outline.hs
@@ -0,0 +1,80 @@
+module Rakka.Wiki.Interpreter.Outline
+    ( interpreters
+    )
+    where
+
+import           Data.Generics
+import           Rakka.Wiki
+import           Rakka.Wiki.Interpreter
+
+
+interpreters :: [Interpreter]
+interpreters = [ outlineInterp ]
+
+
+outlineInterp :: Interpreter
+outlineInterp = BlockCommandInterpreter {
+                  bciName      = "outline"
+                , bciInterpret
+                    = \ ctx _ ->
+                      case ctxMainTree ctx of
+                        Just tree -> return $ Div [("class", "outline")] [List $ mkOutline tree]
+                        Nothing   -> return EmptyBlock
+                }
+
+
+mkOutline :: WikiPage -> ListElement
+mkOutline tree
+    = let headings = listify query tree
+      in
+        fst (mkOutline' emptyOutline 1 headings)
+
+
+query :: Typeable a => a -> Bool
+query = mkQ False $ \ x -> case x of
+                             Heading _ _ -> True
+                             _           -> False
+
+
+emptyOutline :: ListElement
+emptyOutline = ListElement Bullet []
+
+                                   
+mkOutline' :: ListElement -> Int -> [BlockElement] -> (ListElement, [BlockElement])
+mkOutline' soFar _     []     = (soFar, [])
+mkOutline' soFar level (x:xs)
+    = case x of
+        Heading n text
+            | n == level
+                -- 同じレベルなので soFar に單獨の ListItem を追加して
+                -- 續行。
+                -> let link = PageLink {
+                                linkPage     = Nothing
+                              , linkFragment = Just text
+                              , linkText     = Just text
+                              }
+                       item = [Right link]
+                   in
+                     mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
+
+            | n < level
+                -- 低いレベルなのでここで終了。
+                -> (soFar, x:xs)
+
+            | n > level
+                -- 高いレベルなので再帰して ListElement を作り、
+                -- それを soFar の最後の ListItem に追加する。
+                -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
+                       itemsSoFar   = listItems soFar
+
+                       nonLastItems, lastItem :: [ListItem]
+                       (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar
+
+                       lastItem' :: ListItem
+                       lastItem' = case lastItem of
+                                     []   -> [Left nested]
+                                     i:[] -> i ++ [Left nested]
+
+                       soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
+                   in
+                     mkOutline' soFar' level ys