-- --------------------------------------------------------------------------
--  $Revision: 287 $ $Date: 2007-04-25 23:25:57 +0200 (Wed, 25 Apr 2007) $
-- --------------------------------------------------------------------------

-- |
--
-- Module      :  PureFP.Parsers.Standard
-- Copyright   :  Peter Ljunglof 2002
-- License     :  GPL
--
-- Maintainer  :  otakar.smrz mff.cuni.cz
-- Stability   :  provisional
-- Portability :  portable
--
-- Chapters 3 and 4 of /Pure Functional Parsing – an advanced tutorial/
-- by Peter Ljunglöf
--
-- <http://www.ling.gu.se/~peb/pubs/p02-lic-thesis.pdf>
--
-- <http://www.ling.gu.se/~peb/software/functional-parsing/>


--------------------------------------------------
-- the standard parser from section 3.2


module PureFP.Parsers.Standard (Standard (..)) where

import PureFP.Parsers.Parser

import Control.Monad.State


newtype Standard s a = Std ([s] -> [([s], a)])


instance MonadState [s] (Standard s) where

    get = Std (\inp -> [(inp, inp)])

    put s = Std (\inp -> [(s, ())])


instance Monoid (Standard s) where
  zero            = Std (\inp -> [])
  Std p <+> Std q = Std (\inp -> p inp ++ q inp)


instance Monad (Standard s) where
  return a    = Std (\inp -> [(inp,a)])
  Std p >>= k = Std (\inp -> concat [ q inp' |
                                      (inp', a) <- p inp,
                                      let Std q = k a ])


instance Functor (Standard s) where
  fmap f p = do a <- p ; return (f a)
{--
  fmap f (Std p) = Std (\inp -> [ (inp', f a) | (inp', a) <- p inp ])
--}


instance Sequence (Standard s)
{--
  Std p <*> Std q = Std (\inp -> [ (inp'', f a) | (inp', f) <- p inp, (inp'', a) <- q inp' ])
--}


instance Eq s => Symbol (Standard s) s where
  sat p = Std sat'
    where sat' (s:inp) | p s = [(inp, s)]
          sat' _             = []


instance Eq s => SymbolCont (Standard s) s where
  satCont p fut = Std sat'
    where sat' (s:inp) | p s = let Std p = fut s in p inp
          sat' _             = []


instance Parser (Standard s) s where
  parse (Std p) inp = p inp


instance Lookahead (Standard s) s where
  lookahead f = Std (\inp -> let Std p = f inp in p inp)