{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}
module Toc.Semantics.Html where

import Data.List
import Data.HList.Label4
import Data.HList.TypeEqGeneric1
import Data.HList.TypeCastGeneric1
import Language.Grammars.AspectAG
import Language.Grammars.AspectAG.Derive

import Document.Decl
import Toc.Decl
import Document.Semantics.Html
import Document.Semantics.NumberedHeaders
import Toc.Semantics.Toc


-- | Rule that redefines the html attribute for headers such that the associated
--   header number is printed and its "id" value is set for navigation.
header_html' = syn html $ 
    do level  <- at ch_level_header
       inls   <- at ch_inlines_header
       loc    <- at loc
       let num = loc # headerNum
       return $ "<h" ++ show level ++ " id=\"" ++ show num ++ "\">" 
                 ++ formatNH num ++ " "
                 ++ inls # html
                 ++ "</h" ++ show level ++ ">"
                 ++ "\n"

-- | Rule that defines the html attribute for the table of contents
toc_html = syn html $
    do lhs <- at lhs
       return $ formatToc (lhs # toc)

-- | Formats the table of contents to html
formatToc :: [([Int], String)] -> String
formatToc = foldr f ""
    where f (x, section) table = "<a href=#" ++ show x ++ ">" 
                               ++ (formatNH x) ++ " " ++ section 
                               ++ "</a><br />\n" ++ table



semHtml'' = mkDoc' (default_toc  `ext` blockLcons_html 
                                 `ext` default_cHeaderNum    
                                 `ext` default_sToc)
                   (default_toc  `ext` blockLnil_html  
                                 `ext` default_cHeaderNum    
                                 `ext` default_sToc)
                   (bold_html    `ext` bold_sInlStr)
                   (document_toc `ext` document_cHeaderNum 
                                 `ext` document_html)
                   (header_html'     `ext` header_cHeaderNum 
                                     `ext` header_headerNum 
                                     `ext` header_sToc)-- NOTE: this should be aspHeader instead
                   (inlineLcons_html `ext` default_sInlStr)
                   (inlineLnil_html  `ext` default_sInlStr)
                   (italics_html `ext` italics_sInlStr)
                   (default_toc `ext` paragraph_html   
                                `ext` default_cHeaderNum    
                                `ext` default_sToc)
                   (plain_html `ext` plain_sInlStr)


semHtmlToc = mkDocToc (default_toc `ext` toc_html `ext` default_cHeaderNum    `ext` default_sToc)