NumberedHeaders.hs

{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}
module Document.Semantics.NumberedHeaders 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


-- To correctly number every header, we chain a value of type [Int] through the tree,
-- of which the elements correspond to the current section. For example, section 1.3.4
-- is represented as [1, 3, 4].
$(attLabels ["cHeaderNum", "headerNum"])



-- | Computes the header number from the level and its parent header number.
updateHeaderNum :: Int -> [Int] -> [Int]
updateHeaderNum level par = zipWith (+) par' (zeros ++ [1]) 
    where par'  = par ++ repeat 0
          zeros = replicate (level - 1) 0

-- | Formats a header number, i.e. [3,1,4] becomes "3.1.4"
formatNH :: [Int] -> String
formatNH = intercalate "." . map show           






cHeaderNum_NTs = nt_BlockL .*. nt_Block .*. hNil


-- The general rule for the chained attribute
default_cHeaderNum = chain cHeaderNum cHeaderNum_NTs

document_cHeaderNum = inh cHeaderNum cHeaderNum_NTs $ return (ch_blocks .=. ([] :: [Int]) .*. emptyRecord)

-- Specific rule to update the header counter (if header level is 2)
header_cHeaderNum = syn cHeaderNum $
                        do loc   <- at loc
                           return $ loc # headerNum




header_headerNum = locdefM headerNum $
                        do lhs   <- at lhs
                           level <- at ch_level_header
                           return $ updateHeaderNum level (lhs # cHeaderNum)



{- -- OLD, not extensible
asp_cHeaderNum =  (p_Document    .=. default_cHeaderNum)
              .*. (p_BlockL_Cons .=. default_cHeaderNum)
              .*. (p_BlockL_Nil  .=. default_cHeaderNum)
              .*. (p_Paragraph   .=. default_cHeaderNum)
              .*. (p_Header      .=. header_cHeaderNum)
              .*. (p_InlineL_Nil  .=. emptyRule)
              .*. (p_InlineL_Cons .=. emptyRule)
              .*. (p_Plain        .=. emptyRule)
              .*. (p_Bold         .=. emptyRule) 
              .*. (p_Italics      .=. emptyRule)
              .*. emptyRecord


semHeaderNum :: Document -> Int
semHeaderNum doc = sem_Document asp_cHeaderNum doc (cHeaderNum .=. 1 .*. emptyRecord) # cHeaderNum
-}