5 module Rakka.Wiki.Interpreter.Outline
11 import Rakka.Wiki.Interpreter
13 interpreters :: [Interpreter]
14 interpreters = [ outlineInterp ]
17 outlineInterp :: Interpreter
18 outlineInterp = BlockCommandInterpreter {
22 case ctxMainWiki ctx of
23 Just tree -> return $ Div [("class", "outline")] [Block $ mkOutline tree]
24 Nothing -> return EmptyBlock
28 mkOutline :: WikiPage -> BlockElement
29 mkOutline tree = fst (mkOutline' emptyOutline 1 headings)
31 headings :: [BlockElement]
32 headings = concatMap collectInBlock tree
34 collectInBlock :: BlockElement -> [BlockElement]
35 collectInBlock hd@(Heading _ _)
37 collectInBlock (Div _ xs)
38 = concatMap collectInBlock $ catMaybes (map castToBlock xs)
39 collectInBlock (BlockCmd (BlockCommand _ _ xs))
40 = concatMap collectInBlock xs
44 castToBlock :: Element -> Maybe BlockElement
45 castToBlock (Block e) = Just e
46 castToBlock _ = Nothing
49 emptyOutline :: BlockElement
50 emptyOutline = List Bullet []
53 mkOutline' :: BlockElement -> Int -> [BlockElement] -> (BlockElement, [BlockElement])
54 mkOutline' soFar _ [] = (soFar, [])
55 mkOutline' soFar level (x:xs)
59 -- 同じレベルなので soFar に單獨の ListItem を追加して
61 -> let link = PageLink {
63 , linkFragment = Just text
64 , linkText = Just text
68 mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
75 -- 高いレベルなので再帰して ListElement を作り、
76 -- それを soFar の最後の ListItem に追加する。
77 -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
78 itemsSoFar = listItems soFar
80 nonLastItems, lastItem :: [ListItem]
81 (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar
84 lastItem' = case lastItem of
86 i:[] -> i ++ [Block nested]
89 soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
91 mkOutline' soFar' level ys