X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FOutline.hs;h=3c66db1d90b6913032d20b30bf8c34a931529a3b;hb=42f51754dea02201aececaacbf194d714cd58aaf;hp=04554a69b85b09dbe5a1f4a10974d162d871aa70;hpb=8f77b5949ccd5f2272a02c852d51bfa2ecfa84c8;p=Rakka.git

diff --git a/Rakka/Wiki/Interpreter/Outline.hs b/Rakka/Wiki/Interpreter/Outline.hs
index 04554a6..3c66db1 100644
--- a/Rakka/Wiki/Interpreter/Outline.hs
+++ b/Rakka/Wiki/Interpreter/Outline.hs
@@ -1,12 +1,14 @@
+{-# LANGUAGE
+    OverloadedStrings
+  , UnicodeSyntax
+  #-}
 module Rakka.Wiki.Interpreter.Outline
     ( interpreters
     )
     where
-
-import           Data.Generics
-import           Rakka.Wiki
-import           Rakka.Wiki.Interpreter
-
+import Data.Maybe
+import Rakka.Wiki
+import Rakka.Wiki.Interpreter
 
 interpreters :: [Interpreter]
 interpreters = [ outlineInterp ]
@@ -17,30 +19,38 @@ outlineInterp = BlockCommandInterpreter {
                   bciName      = "outline"
                 , bciInterpret
                     = \ ctx _ ->
-                      case ctxMainTree ctx of
-                        Just tree -> return $ Div [("class", "outline")] [List $ mkOutline tree]
+                      case ctxMainWiki ctx of
+                        Just tree -> return $ Div [("class", "outline")] [Block $ mkOutline tree]
                         Nothing   -> return EmptyBlock
                 }
 
 
-mkOutline :: WikiPage -> ListElement
-mkOutline tree
-    = let headings = listify query tree
-      in
-        fst (mkOutline' emptyOutline 1 headings)
+mkOutline :: WikiPage -> BlockElement
+mkOutline tree = fst (mkOutline' emptyOutline 1 headings)
+    where
+      headings :: [BlockElement]
+      headings = concatMap collectInBlock tree
 
+      collectInBlock :: BlockElement -> [BlockElement]
+      collectInBlock hd@(Heading _ _)
+          = [hd]
+      collectInBlock (Div _ xs)
+          = concatMap collectInBlock $ catMaybes (map castToBlock xs)
+      collectInBlock (BlockCmd (BlockCommand _ _ xs))
+          = concatMap collectInBlock xs
+      collectInBlock _
+          = []
 
-query :: Typeable a => a -> Bool
-query = mkQ False $ \ x -> case x of
-                             Heading _ _ -> True
-                             _           -> False
+      castToBlock :: Element -> Maybe BlockElement
+      castToBlock (Block e) = Just e
+      castToBlock _         = Nothing
 
 
-emptyOutline :: ListElement
-emptyOutline = ListElement Bullet []
+emptyOutline :: BlockElement
+emptyOutline = List Bullet []
 
                                    
-mkOutline' :: ListElement -> Int -> [BlockElement] -> (ListElement, [BlockElement])
+mkOutline' :: BlockElement -> Int -> [BlockElement] -> (BlockElement, [BlockElement])
 mkOutline' soFar _     []     = (soFar, [])
 mkOutline' soFar level (x:xs)
     = case x of
@@ -53,7 +63,7 @@ mkOutline' soFar level (x:xs)
                               , linkFragment = Just text
                               , linkText     = Just text
                               }
-                       item = [Right link]
+                       item = [Inline link]
                    in
                      mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
 
@@ -72,9 +82,11 @@ mkOutline' soFar level (x:xs)
 
                        lastItem' :: ListItem
                        lastItem' = case lastItem of
-                                     []   -> [Left nested]
-                                     i:[] -> i ++ [Left nested]
+                                     []   -> [Block nested]
+                                     i:[] -> i ++ [Block nested]
+                                     _    -> undefined
 
                        soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
                    in
                      mkOutline' soFar' level ys
+        _ -> undefined
\ No newline at end of file