--------------------------------------------------------------------------------
--                                                                            --
--  ParserMonad and Parser class                                              --
--                                                                            --
--------------------------------------------------------------------------------

-- ParserMonad

class MonadPlus m => ParserMonad m where
  item :: m Char
  invokeWith :: m x -> (x -> IO ()) -> String -> IO ()

-- a simple ParserMonad instance

type TheParser = StateT String (ErrT Id)

instance ParserMonad TheParser where
  item = do { ch <- take ; drop ; result ch }
        where
         take = takeFirst :: TheParser Char
         drop = dropFirst :: TheParser String           
  invokeWith = invokeWithRW   

-- Parser class
              
class ParserMonad m => Parser m x where               
  parser :: m x

-- parsing recursive types

instance (Rec rec, Parser m (f (rec f))) => Parser m (rec f) where
  parser = map rec parser

--------------------------------------------------------------------------------
--                                                                            --
--  derived ParserMonad utilities                                             --
--                                                                            --
--------------------------------------------------------------------------------

sat :: ParserMonad m => (Char -> Bool) -> m Char
sat p = do { ch <- item ; if p ch ; result ch }

lower :: ParserMonad m => m Char
lower = sat isLower

digit :: ParserMonad m => m Char
digit = sat isDigit

char :: ParserMonad m => Char -> m ()
char x = do { sat (x ==) ; result () }

blank :: ParserMonad m => m Char
blank = sat (' ' ==)

lowers :: ParserMonad m => m String
lowers = many1 lower 

digits :: ParserMonad m => m String
digits = many1 digit 

chars :: ParserMonad m => String -> m ()
chars [] = result ()
chars (x:xs) = do { char x ; chars xs }

blanks :: ParserMonad m => m String
blanks = many blank 

-- parsing basics

pLit :: ParserMonad m => String -> m ()
pLit str = do { chars str ; blanks ; result () } 
   
pLow :: ParserMonad m => m String
pLow = do { ls <- lowers ; blanks ; result ls }

pInt :: ParserMonad m => m Int
pInt =  do { ds <- digits ; blanks ; result (ds2i ds) }
       where 
        ds2i = foldl (\a d -> 10*a + (ord d - ord '0')) 0

pList :: ParserMonad m => m x -> m [x]
pList parser 
  = do { pLit "[" ; xs <- list (pLit ",") parser ; pLit "]" ; result xs }

--------------------------------------------------------------------------------
    



