Rakka/Wiki/Interpreter/Outline.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 module Rakka.Wiki.Interpreter.Outline
   6     ( interpreters
   7     )
   8     where
   9 import Data.Maybe
  10 import Rakka.Wiki
  11 import Rakka.Wiki.Interpreter
  12
  13 interpreters :: [Interpreter]
  14 interpreters = [ outlineInterp ]
  15
  16
  17 outlineInterp :: Interpreter
  18 outlineInterp = BlockCommandInterpreter {
  19                   bciName      = "outline"
  20                 , bciInterpret
  21                     = \ ctx _ ->
  22                       case ctxMainWiki ctx of
  23                         Just tree -> return $ Div [("class", "outline")] [Block $ mkOutline tree]
  24                         Nothing   -> return EmptyBlock
  25                 }
  26
  27
  28 mkOutline :: WikiPage -> BlockElement
  29 mkOutline tree = fst (mkOutline' emptyOutline 1 headings)
  30     where
  31       headings :: [BlockElement]
  32       headings = concatMap collectInBlock tree
  33
  34       collectInBlock :: BlockElement -> [BlockElement]
  35       collectInBlock hd@(Heading _ _)
  36           = [hd]
  37       collectInBlock (Div _ xs)
  38           = concatMap collectInBlock $ catMaybes (map castToBlock xs)
  39       collectInBlock (BlockCmd (BlockCommand _ _ xs))
  40           = concatMap collectInBlock xs
  41       collectInBlock _
  42           = []
  43
  44       castToBlock :: Element -> Maybe BlockElement
  45       castToBlock (Block e) = Just e
  46       castToBlock _         = Nothing
  47
  48
  49 emptyOutline :: BlockElement
  50 emptyOutline = List Bullet []
  51
  52
  53 mkOutline' :: BlockElement -> Int -> [BlockElement] -> (BlockElement, [BlockElement])
  54 mkOutline' soFar _     []     = (soFar, [])
  55 mkOutline' soFar level (x:xs)
  56     = case x of
  57         Heading n text
  58             | n == level
  59                 -- 同じレベルなので soFar に單獨の ListItem を追加して
  60                 -- 續行。
  61                 -> let link = PageLink {
  62                                 linkPage     = Nothing
  63                               , linkFragment = Just text
  64                               , linkText     = Just text
  65                               }
  66                        item = [Inline link]
  67                    in
  68                      mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs
  69
  70             | n < level
  71                 -- 低いレベルなのでここで終了。
  72                 -> (soFar, x:xs)
  73
  74             | n > level
  75                 -- 高いレベルなので再帰して ListElement を作り、
  76                 -- それを soFar の最後の ListItem に追加する。
  77                 -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
  78                        itemsSoFar   = listItems soFar
  79
  80                        nonLastItems, lastItem :: [ListItem]
  81                        (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar
  82
  83                        lastItem' :: ListItem
  84                        lastItem' = case lastItem of
  85                                      []   -> [Block nested]
  86                                      i:[] -> i ++ [Block nested]
  87                                      _    -> undefined
  88
  89                        soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
  90                    in
  91                      mkOutline' soFar' level ys
  92         _ -> undefined