Latex.hs

{-# LANGUAGE Arrows, RecursiveDo, EmptyDataDecls, TemplateHaskell, PostfixOperators, FlexibleContexts #-}

module Document.Grammars.Latex where

import Control.Applicative

import Language.Grammars.Grammar
import Language.Grammars.Murder
import Language.Grammars.Murder.Derive
import Language.Grammars.Murder.UUParsing
import Language.Grammars.AspectAG
import Document.Decl
import Utils

$(csLabels  ["cs_document", "cs_blockL", "cs_block", "cs_paragraph", "cs_header", "cs_inline", "cs_inlineL"])


-- The grammar is parametrised by the semantic record (sem)
gLatex sem = proc () -> do
    rec
        document     <-addNT-< iI (pDocument sem) blockL Ii


        ------------------------------
        -- block level
        ------------------------------
        blockL       <-addNT-< pFoldr (pBlockL_Cons sem, pBlockL_Nil sem) $ 
                                   iI block Ii
        
        block        <-addNT-< iI header Ii <|> iI paragraph Ii

        paragraph    <-addNT-< iI (pParagraph sem) "\\begin" "{" "paragraph" "}" 
                                                   inlineL 
                                                   "\\end"   "{" "paragraph" "}" Ii
        
        header       <-addNT-< let h (x, name) = iI (pHeader sem x) "\\" name "{" inlineL "}" Ii
                                   headers     = [(1,"section"), (2, "subsection"), (3, "subsubsection")]
                               in  foldr1 (<|>) (map h headers)
                                   

        -------------------------------
        -- inline level
        -------------------------------


        inlineL      <-addNT-< pFoldr (pInlineL_Cons sem, pInlineL_Nil sem) $
                                   iI inline Ii

        inline       <-addNT-< iI (pPlain   sem) "\\plain"  "{" (someExcept "\\&%$#_{}~^") "}" Ii
                        <|>    iI (pBold    sem) "\\textbf" "{" inlineL          "}" Ii
                        <|>    iI (pItalics sem) "\\textit" "{" inlineL          "}" Ii

        --------------------------------
        -- plain text primitives
        --------------------------------
        
        text         <-addNT-< iI       word Ii 
                        <|>    iI pText word (ign space) text (ign space) Ii
        

        let specials = "\\&%$#_{}~^"
        let wspace   = " \t"

        -- recognizes whitespace (no newlines)
        space        <-addNT-< iI id (someOf wspace) Ii
        
        -- non empty sequence of characters that are not special
        word         <-addNT-< iI (someExcept (specials ++ wspace)) Ii

{-        
    exportNTs -< exportList text id
  -}    


    exportNTs -<  exportList document ( export cs_document      document
                                      . export cs_blockL        blockL
                                      . export cs_block         block
                                      . export cs_paragraph     paragraph
                                      . export cs_header        header
                                      . export cs_inline        inline
                                      . export cs_inlineL       inlineL)

pText w ws = w ++ " " ++ ws