MyDoc.hs

module MyDoc where

import Text.PrettyPrint
import EnvM
import MUtils 
import Monad
import Char(isSpace)


type Heading    = (Int,String)
data TxtDec     = Plain | Emph | Code | Math    deriving (Eq,Show)
type DecString  = (TxtDec,String)

type Code       = [String]
type TxtBlock   = [Paragraph]
data Paragraph  = Txt [[DecString]] | Lst [TxtBlock] | H Heading  deriving Show

type MyDoc      = [Either TxtBlock Code]


data Style = Style 
    { ppHeading   :: Heading -> Doc
    , ppDecStr    :: DecString -> Doc
    , ppCode      :: Code -> Doc

    , ppList      :: [Doc] -> Doc
    , ppItem      :: Doc -> Doc

    , ppParagraph :: Doc -> Doc

    , ppText      :: Doc -> Doc
    , ppFinalize  :: Doc -> Doc
    }


env f x = do e <- getEnv
             return (f e x)

ppH x = env ppHeading x
ppS x = env ppDecStr x
ppC x = env ppCode x

ppL x = env ppList x
ppI x = env ppItem x

ppP x = env ppParagraph x
ppT x = env ppText x
ppF x = env ppFinalize x


ppMyDoc d = ppF =<< (vcat # mapM (either topLevel ppC) d)

topLevel d = ppT =<< (vcat # mapM prt d)
    where
    prt ((H h):xs)  = liftM2 ($$) (ppH h) (prt xs)
    prt ((Txt as):xs) 
        | emp as    = (text "" $$) # prt xs

    prt x           = vcat # mapM (ppP @@ ppPar) x
    

ppTxtBlock d    = vcat # mapM ppPar d

ppPar (Txt tss) = vcat # mapM (\ts -> hcat # mapM ppS ts) tss
ppPar (Lst is)  = ppL =<< mapM (ppI @@ ppTxtBlock) is
ppPar (H _)     = error "inner heading? (MyDoc.hs)"

emp []          = True
emp ([]:xss)    = emp xss
emp (xs:xss)    = all (all isSpace.snd) xs && emp xss