X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FOutline.hs;h=3c66db1d90b6913032d20b30bf8c34a931529a3b;hb=42f51754dea02201aececaacbf194d714cd58aaf;hp=eb8c9d4db095b3b1d2e8e14edcabf9a65b7c8664;hpb=e43bb104a7313dd696b8bb8aa3bafff94706a187;p=Rakka.git diff --git a/Rakka/Wiki/Interpreter/Outline.hs b/Rakka/Wiki/Interpreter/Outline.hs index eb8c9d4..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,23 +19,31 @@ outlineInterp = BlockCommandInterpreter { 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 @@ -74,7 +84,9 @@ mkOutline' soFar level (x:xs) 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