1 module Rakka.Wiki.Interpreter.Outline
8 import Rakka.Wiki.Interpreter
11 interpreters :: [Interpreter]
12 interpreters = [ outlineInterp ]
15 outlineInterp :: Interpreter
16 outlineInterp = BlockCommandInterpreter {
20 case ctxMainTree ctx of
21 Just tree -> return $ Div [("class", "outline")] [List $ mkOutline tree]
22 Nothing -> return EmptyBlock
26 mkOutline :: WikiPage -> ListElement
28 = let headings = listify query tree
30 fst (mkOutline' emptyOutline 1 headings)
33 query :: Typeable a => a -> Bool
34 query = mkQ False $ \ x -> case x of
39 emptyOutline :: ListElement
40 emptyOutline = ListElement Bullet []
43 mkOutline' :: ListElement -> Int -> [BlockElement] -> (ListElement, [BlockElement])
44 mkOutline' soFar _ [] = (soFar, [])
45 mkOutline' soFar level (x:xs)
49 -- 同じレベルなので soFar に單獨の ListItem を追加して
51 -> let link = PageLink {
53 , linkFragment = Just text
54 , linkText = Just text
58 mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
65 -- 高いレベルなので再帰して ListElement を作り、
66 -- それを soFar の最後の ListItem に追加する。
67 -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
68 itemsSoFar = listItems soFar
70 nonLastItems, lastItem :: [ListItem]
71 (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar
74 lastItem' = case lastItem of
76 i:[] -> i ++ [Left nested]
78 soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
80 mkOutline' soFar' level ys