{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-} module Document.Semantics.Html where import Control.Monad import Data.HList.Label4 import Data.HList.TypeEqGeneric1 import Data.HList.TypeCastGeneric1 import Language.Grammars.AspectAG import Language.Grammars.AspectAG.Derive import Document.Decl $(attLabels ["html"]) -- Document production document_html = syn html $ do blocks <- at ch_blocks return $ blocks # html -- Blocks productions blockLnil_html = syn html $ return "" blockLcons_html = syn html $ do block <- at ch_hd_BlockL_Cons blocks <- at ch_tl_BlockL_Cons return $ block # html ++ blocks # html --blockLcons_html = use html (nt_BlockL .*. HNil) (++) "" -- Block productions header_html = syn html $ do level <- at ch_level_header inls <- at ch_inlines_header return $ "" ++ inls # html ++ "" ++ "\n" paragraph_html = syn html $ do inls <- at ch_inlines_par return $ "

" ++ inls # html ++ "

" ++ "\n" -- Inline productions inlineLnil_html = syn html $ return "" inlineLcons_html = syn html $ do inl <- at ch_hd_InlineL_Cons inls <- at ch_tl_InlineL_Cons return $ inl # html ++ inls # html plain_html = syn html $ at ch_str_plainInl bold_html = syn html $ do inls <- at ch_inlines_boldInl return $ "" ++ inls # html ++ "" italics_html = syn html $ do inls <- at ch_inlines_italInl return $ "" ++ inls # html ++ "" ----------------------- -- building the record {- aspDocument = document_html aspBlockL_Nil = blockLnil_html aspBlockL_Cons = blockLcons_html aspHeader = header_html aspParagraph = paragraph_html aspInlineL_Nil = inlineLnil_html aspInlineL_Cons = inlineLcons_html aspPlain = plain_html aspBold = bold_html aspItalics = italics_html -} semHtml = mkDoc' blockLcons_html blockLnil_html bold_html document_html header_html inlineLcons_html inlineLnil_html italics_html paragraph_html plain_html -- slightly edited mkDoc (from TH splice) mkDoc' _BlockL_Cons _BlockL_Nil _Bold _Document _Header _InlineL_Cons _InlineL_Nil _Italics _Paragraph _Plain = DocSF {pBlockL_Cons = semP_BlockL_Cons _BlockL_Cons, pBlockL_Nil = semP_BlockL_Nil _BlockL_Nil, pBold = semP_Bold _Bold, pDocument = semP_Document _Document, pHeader = semP_Header _Header . sem_Lit, pInlineL_Cons = semP_InlineL_Cons _InlineL_Cons, pInlineL_Nil = semP_InlineL_Nil _InlineL_Nil, pItalics = semP_Italics _Italics, pParagraph = semP_Paragraph _Paragraph, pPlain = semP_Plain _Plain . sem_Lit} {- -- OLD, not extensible semHtmlNotExtensible :: Document -> String semHtmlNotExtensible doc = sem_Document asp_html doc () # html ------------------------------------------ -- Initial aspect html (synthesized html) ------------------------------------------ -- The aspect is a heterogenous list of pairs of production and rule asp_html = (p_Document .=. document_html) .*. (p_BlockL_Nil .=. blockLnil_html) .*. (p_BlockL_Cons .=. blockLcons_html) .*. (p_Header .=. header_html) .*. (p_Paragraph .=. paragraph_html) .*. (p_InlineL_Nil .=. inlineLnil_html) .*. (p_InlineL_Cons .=. inlineLcons_html) .*. (p_Plain .=. plain_html) .*. (p_Bold .=. bold_html) .*. (p_Italics .=. italics_html) .*. emptyRecord -}