+{-# 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 ]
bciName = "outline"
, bciInterpret
= \ ctx _ ->
- case ctxMainTree ctx of
+ case ctxMainWiki ctx of
Just tree -> return $ Div [("class", "outline")] [Block $ mkOutline tree]
Nothing -> return EmptyBlock
}
mkOutline :: WikiPage -> BlockElement
-mkOutline tree
- = let headings = listify query tree
- in
- fst (mkOutline' emptyOutline 1 headings)
+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 :: BlockElement
lastItem' = case lastItem of
[] -> [Block nested]
i:[] -> i ++ [Block nested]
+ _ -> undefined
soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
in
mkOutline' soFar' level ys
+ _ -> undefined
\ No newline at end of file