X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FOutline.hs;h=ef9c32058b03de0a69476090f2a7e8df07aa7d7e;hb=45a315230ec341d3f7a9b80f8004148949a5e2e5;hp=16ed0c5f7999ad52670df7398ca10e41f8a7b647;hpb=65c7f9f0643c7e8884e4a02567b77c169167c093;p=Rakka.git diff --git a/Rakka/Wiki/Interpreter/Outline.hs b/Rakka/Wiki/Interpreter/Outline.hs index 16ed0c5..ef9c320 100644 --- a/Rakka/Wiki/Interpreter/Outline.hs +++ b/Rakka/Wiki/Interpreter/Outline.hs @@ -3,7 +3,7 @@ module Rakka.Wiki.Interpreter.Outline ) where -import Data.Generics +import Data.Maybe import Rakka.Wiki import Rakka.Wiki.Interpreter @@ -24,16 +24,24 @@ outlineInterp = BlockCommandInterpreter { mkOutline :: WikiPage -> BlockElement -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 +mkOutline tree = fst (mkOutline' emptyOutline 1 headings) + where + headings :: [BlockElement] + headings = concat (map collectInBlock tree) + + collectInBlock :: BlockElement -> [BlockElement] + collectInBlock hd@(Heading _ _) + = [hd] + collectInBlock (Div _ xs) + = concat $ map collectInBlock $ catMaybes (map castToBlock xs) + collectInBlock (BlockCmd (BlockCommand _ _ xs)) + = concat $ map collectInBlock xs + collectInBlock _ + = [] + + castToBlock :: Element -> Maybe BlockElement + castToBlock (Block e) = Just e + castToBlock _ = Nothing emptyOutline :: BlockElement