module Rakka.Wiki.Interpreter.Outline
    ( interpreters
    )
    where

import           Data.Generics
import           Rakka.Wiki
import           Rakka.Wiki.Interpreter


interpreters :: [Interpreter]
interpreters = [ outlineInterp ]


outlineInterp :: Interpreter
outlineInterp = BlockCommandInterpreter {
                  bciName      = "outline"
                , bciInterpret
                    = \ ctx _ ->
                      case ctxMainTree 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)


query :: Typeable a => a -> Bool
query = mkQ False $ \ x -> case x of
                             Heading _ _ -> True
                             _           -> False


emptyOutline :: BlockElement
emptyOutline = List Bullet []

                                   
mkOutline' :: BlockElement -> Int -> [BlockElement] -> (BlockElement, [BlockElement])
mkOutline' soFar _     []     = (soFar, [])
mkOutline' soFar level (x:xs)
    = case x of
        Heading n text
            | n == level
                -- 同じレベルなので soFar に單獨の ListItem を追加して
                -- 續行。
                -> let link = PageLink {
                                linkPage     = Nothing
                              , linkFragment = Just text
                              , linkText     = Just text
                              }
                       item = [Inline link]
                   in
                     mkOutline' (soFar { listItems = listItems soFar ++ [item] }) n xs

            | n < level
                -- 低いレベルなのでここで終了。
                -> (soFar, x:xs)

            | n > level
                -- 高いレベルなので再帰して ListElement を作り、
                -- それを soFar の最後の ListItem に追加する。
                -> let (nested, ys) = mkOutline' emptyOutline (level + 1) (x:xs)
                       itemsSoFar   = listItems soFar

                       nonLastItems, lastItem :: [ListItem]
                       (nonLastItems, lastItem) = splitAt (length itemsSoFar - 1) itemsSoFar

                       lastItem' :: ListItem
                       lastItem' = case lastItem of
                                     []   -> [Block nested]
                                     i:[] -> i ++ [Block nested]

                       soFar' = soFar { listItems = nonLastItems ++ [lastItem'] }
                   in
                     mkOutline' soFar' level ys