1 module Rakka.Wiki.Interpreter.Base.Outline
8 import Rakka.Wiki.Interpreter
11 outlineInterp :: Interpreter
12 outlineInterp = BlockCommandInterpreter {
16 case ctxMainTree ctx of
17 Just tree -> return $ Div [("class", "outline")] [List $ mkOutline tree]
18 Nothing -> return EmptyBlock
22 mkOutline :: WikiPage -> ListElement
24 = let headings = listify query tree
26 fst (mkOutline' emptyOutline 1 headings)
29 query :: Typeable a => a -> Bool
30 query = mkQ False $ \ x -> case x of
35 emptyOutline :: ListElement
36 emptyOutline = ListElement Bullet []
39 mkOutline' :: ListElement -> Int -> [BlockElement] -> (ListElement, [BlockElement])
40 mkOutline' soFar _ [] = (soFar, [])
41 mkOutline' soFar level (x:xs)
45 -- 同じレベルなので soFar に單獨の ListItem を追加して
47 -> let link = PageLink {
49 , linkFragment = Just text
50 , linkText = Just text
54 mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
61 -- 高いレベルなので再帰して ListElement を作り、
62 -- それを soFar の最後の ListItem に追加する。
63 -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
64 itemsSoFar = listItems soFar
66 nonLastItems, lastItem :: [ListItem]
67 (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar
70 lastItem' = case lastItem of
72 i:[] -> i ++ [Left nested]
74 soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
76 mkOutline' soFar' level ys