--
-- MTLParseCore.hs
--
-- Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--
-- This file is part of mtlparse library
--
-- mtlparse is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or any later version.
--
-- mtlparse is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANGY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.

{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE UndecidableInstances   #-}

module Text.ParserCombinators.MTLParse.MTLParseCore (

  -- * MonadParse class
  MonadParse( spot, spotBack, still, parseNot, getHere, putHere,
              noBacktrack )

, token
, tokenBack

, getsHere
, modifyHere

, getForward
, getsForward
, putForward
, modifyForward

, getBack
, getsBack
, putBack
, modifyBack

  -- * The Parse Monad
, Parse(..)
, evalParse
, execParse
, mapParse
, withParse

  -- * The ParseT Monad
, ParseT(..)
, evalParseT
, execParseT
, mapParseT
, withParseT

, module Control.Monad
, module Control.Monad.Trans

) where

import Control.Applicative  ( Applicative(..), Alternative(..)   )
import Control.Monad        ( MonadPlus, mplus, mzero, liftM, ap )
import Control.Monad.Trans  ( MonadTrans( lift ),
                              MonadIO, liftIO                    )
import Control.Monad.Reader ( MonadReader( ask, local ),
                              ReaderT( ReaderT, runReaderT ),
                              mapReaderT                         )
import Control.Monad.Writer ( MonadWriter( tell, listen, pass ),
                              WriterT( WriterT, runWriterT ),
                              mapWriterT                         )
import Control.Monad.State  ( MonadState( get, put ),
                              StateT( StateT, runStateT ),
                              mapStateT                          )
import Control.Arrow        ( first, second                      )
import Data.Monoid          ( Monoid( mempty )                   )

class Monad m => MonadParse a m | m -> a where
  spot        :: ( a -> Bool ) -> m a
  spotBack    :: ( a -> Bool ) -> m a
  still       :: m b -> m b
  parseNot    :: c -> m b -> m c
  getHere     :: m ( [a], [a] )
  putHere     :: ( [a], [a] ) -> m ()
  noBacktrack :: m b -> m b

token, tokenBack :: ( Eq a, MonadParse a m ) => a -> m a
token :: forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token     a
x = forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot     (forall a. Eq a => a -> a -> Bool
==a
x)
tokenBack :: forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
tokenBack a
x = forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack (forall a. Eq a => a -> a -> Bool
==a
x)

getsHere   :: MonadParse a m => ( ([a], [a]) -> b ) -> m b
modifyHere :: MonadParse a m => ( ([a], [a]) -> ([a], [a]) ) -> m ()
getsHere :: forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere   ([a], [a]) -> b
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([a], [a]) -> b
f forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
modifyHere :: forall a (m :: * -> *).
MonadParse a m =>
(([a], [a]) -> ([a], [a])) -> m ()
modifyHere ([a], [a]) -> ([a], [a])
f = forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
f

getBack, getForward   :: MonadParse a m => m [ a ]
getsBack, getsForward :: MonadParse a m => ( [a] -> [a] ) -> m [ a ]
getBack :: forall a (m :: * -> *). MonadParse a m => m [a]
getBack       = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere forall a b. (a, b) -> a
fst
getForward :: forall a (m :: * -> *). MonadParse a m => m [a]
getForward    = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere forall a b. (a, b) -> b
snd
getsBack :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m [a]
getsBack    [a] -> [a]
f = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ( [a] -> [a]
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst )
getsForward :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m [a]
getsForward [a] -> [a]
f = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ( [a] -> [a]
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd )

putBack, putForward       :: MonadParse a m => [ a ] -> m ()
modifyBack, modifyForward :: MonadParse a m => ( [a] -> [a] ) -> m ()
putBack :: forall a (m :: * -> *). MonadParse a m => [a] -> m ()
putBack    [a]
b  = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [a]
b
putForward :: forall a (m :: * -> *). MonadParse a m => [a] -> m ()
putForward [a]
f  = forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere forall a b. (a, b) -> a
fst forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a]
f
modifyBack :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m ()
modifyBack    = forall a (m :: * -> *).
MonadParse a m =>
(([a], [a]) -> ([a], [a])) -> m ()
modifyHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
modifyForward :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m ()
modifyForward = forall a (m :: * -> *).
MonadParse a m =>
(([a], [a]) -> ([a], [a])) -> m ()
modifyHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second

-- | A parse monad where /a/ is the type of the token to parse
-- and /b/ is the type of the /return value/.

newtype Parse a b
  = Parse { forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse :: ( [a], [a] ) -> [ ( b, ([a], [a]) ) ] }

-- Parse is instance of Functor Monad MonadPlus MonadReader MonadParse

instance Functor ( Parse p ) where
  fmap :: forall a b. (a -> b) -> Parse p a -> Parse p b
fmap a -> b
f Parse p a
m = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ( forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse p a
m

instance Applicative ( Parse p ) where
  pure :: forall a. a -> Parse p a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return; <*> :: forall a b. Parse p (a -> b) -> Parse p a -> Parse p b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative (Parse p ) where
  empty :: forall a. Parse p a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. Parse p a -> Parse p a -> Parse p a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad ( Parse a ) where
  return :: forall a. a -> Parse a a
return = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. \a
val ([a], [a])
inp -> [ (a
val, ([a], [a])
inp) ]
  Parse ([a], [a]) -> [(a, ([a], [a]))]
pr >>= :: forall a b. Parse a a -> (a -> Parse a b) -> Parse a b
>>= a -> Parse a b
f
         = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ( \([a], [a])
st -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	     [ forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse ( a -> Parse a b
f a
a ) ([a], [a])
rest | ( a
a, ([a], [a])
rest ) <- ([a], [a]) -> [(a, ([a], [a]))]
pr ([a], [a])
st ] )

instance MonadPlus ( Parse a ) where
  mzero :: forall a. Parse a a
mzero                     = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const []
  Parse ([a], [a]) -> [(a, ([a], [a]))]
p1 mplus :: forall a. Parse a a -> Parse a a -> Parse a a
`mplus` Parse ([a], [a]) -> [(a, ([a], [a]))]
p2 = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> ([a], [a]) -> [(a, ([a], [a]))]
p1 ([a], [a])
inp forall a. [a] -> [a] -> [a]
++ ([a], [a]) -> [(a, ([a], [a]))]
p2 ([a], [a])
inp

instance MonadReader ( [a], [a] ) ( Parse a ) where
  ask :: Parse a ([a], [a])
ask       = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> [ (([a], [a])
inp, ([a], [a])
inp) ]
  local :: forall a. (([a], [a]) -> ([a], [a])) -> Parse a a -> Parse a a
local ([a], [a]) -> ([a], [a])
f Parse a a
m = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
f

instance MonadState ( [a], [a] ) ( Parse a ) where
  get :: Parse a ([a], [a])
get     = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> [ (([a], [a])
inp, ([a], [a])
inp) ]
  put :: ([a], [a]) -> Parse a ()
put ([a], [a])
inp = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const [ ((), ([a], [a])
inp) ]

instance MonadParse a ( Parse a ) where
  spot :: (a -> Bool) -> Parse a a
spot = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
spt
    where
    spt :: (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
spt a -> Bool
p ( [a]
pre, a
x:[a]
xs )
      | a -> Bool
p a
x         = [ ( a
x, (a
xforall a. a -> [a] -> [a]
:[a]
pre, [a]
xs) ) ]
      | Bool
otherwise   = []
    spt a -> Bool
_ ( [a]
_, [] ) = []
  spotBack :: (a -> Bool) -> Parse a a
spotBack = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
sptbck
    where
    sptbck :: (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
sptbck a -> Bool
p ( a
x:[a]
xs, [a]
post )
      | a -> Bool
p a
x            = [ ( a
x, ([a]
xs, a
xforall a. a -> [a] -> [a]
:[a]
post) ) ]
      | Bool
otherwise      = []
    sptbck a -> Bool
_ ( [], [a]
_ ) = []
  still :: forall b. Parse a b -> Parse a b
still Parse a b
p = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do ( b
ret, ([a], [a])
_ ) <- forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
p ([a], [a])
inp
                               forall (m :: * -> *) a. Monad m => a -> m a
return ( b
ret, ([a], [a])
inp )
  parseNot :: forall c b. c -> Parse a b -> Parse a c
parseNot c
x ( Parse ([a], [a]) -> [(b, ([a], [a]))]
p ) = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> case ([a], [a]) -> [(b, ([a], [a]))]
p ([a], [a])
inp of
                                                [] -> [ (c
x, ([a], [a])
inp) ]
					        [(b, ([a], [a]))]
_  -> []
  getHere :: Parse a ([a], [a])
getHere = forall s (m :: * -> *). MonadState s m => m s
get
  putHere :: ([a], [a]) -> Parse a ()
putHere = forall s (m :: * -> *). MonadState s m => s -> m ()
put
  noBacktrack :: forall b. Parse a b -> Parse a b
noBacktrack Parse a b
p = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
p

evalParse :: Parse a b -> ( [a], [a] ) -> [ b ]
evalParse :: forall a b. Parse a b -> ([a], [a]) -> [b]
evalParse Parse a b
m = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
m

execParse :: Parse a b -> ( [a], [a] ) -> [ ([a], [a]) ]
execParse :: forall a b. Parse a b -> ([a], [a]) -> [([a], [a])]
execParse Parse a b
m = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
m

mapParse :: ( ( b, ([a], [a]) ) -> ( c, ([a], [a]) ) ) -> Parse a b
                                                       -> Parse a c
mapParse :: forall b a c.
((b, ([a], [a])) -> (c, ([a], [a]))) -> Parse a b -> Parse a c
mapParse (b, ([a], [a])) -> (c, ([a], [a]))
f Parse a b
m = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> (c, ([a], [a]))
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
m

withParse :: ( ([a], [a]) -> ([a], [a]) ) -> Parse a b -> Parse a b
withParse :: forall a a. (([a], [a]) -> ([a], [a])) -> Parse a a -> Parse a a
withParse ([a], [a]) -> ([a], [a])
f Parse a b
m = forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse forall a b. (a -> b) -> a -> b
$ forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
f

-- | A parse monad for encaplulating an inner monad.

newtype ParseT a m b
  = ParseT { forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT :: ( [a], [a] ) -> m [ ( b, ([a], [a]) ) ] }

instance Monad m => Functor ( ParseT a m ) where
  fmap :: forall a b. (a -> b) -> ParseT a m a -> ParseT a m b
fmap a -> b
f ParseT a m a
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> do
               [(a, ([a], [a]))]
rets <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m ([a], [a])
a
	       forall (m :: * -> *) a. Monad m => a -> m a
return [ ( a -> b
f a
a', ([a], [a])
rst ) | ( a
a', ([a], [a])
rst ) <- [(a, ([a], [a]))]
rets ]

instance Monad m => Applicative ( ParseT a m ) where
  pure :: forall a. a -> ParseT a m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return; <*> :: forall a b. ParseT a m (a -> b) -> ParseT a m a -> ParseT a m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Alternative (ParseT a m ) where
  empty :: forall a. ParseT a m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. ParseT a m a -> ParseT a m a -> ParseT a m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad m => Monad ( ParseT a m ) where
  return :: forall a. a -> ParseT a m a
return a
b = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> forall (m :: * -> *) a. Monad m => a -> m a
return [ (a
b, ([a], [a])
a) ]
  ParseT ([a], [a]) -> m [(a, ([a], [a]))]
pr >>= :: forall a b. ParseT a m a -> (a -> ParseT a m b) -> ParseT a m b
>>= a -> ParseT a m b
f
    = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
a ->
        ([a], [a]) -> m [(a, ([a], [a]))]
pr ([a], [a])
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
	  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ( \(a
a', ([a], [a])
rest) -> forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT (a -> ParseT a m b
f a
a') ([a], [a])
rest )

instance Monad m => MonadPlus ( ParseT a m ) where
  mzero :: forall a. ParseT a m a
mzero                       = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return []
  ParseT ([a], [a]) -> m [(a, ([a], [a]))]
p1 mplus :: forall a. ParseT a m a -> ParseT a m a -> ParseT a m a
`mplus` ParseT ([a], [a]) -> m [(a, ([a], [a]))]
p2 = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do [(a, ([a], [a]))]
ret1 <- ([a], [a]) -> m [(a, ([a], [a]))]
p1 ([a], [a])
inp
                                                    [(a, ([a], [a]))]
ret2 <- ([a], [a]) -> m [(a, ([a], [a]))]
p2 ([a], [a])
inp
						    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(a, ([a], [a]))]
ret1 forall a. [a] -> [a] -> [a]
++ [(a, ([a], [a]))]
ret2

instance Monad m => MonadParse a ( ParseT a m ) where
  spot :: (a -> Bool) -> ParseT a m a
spot = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {a}.
Monad m =>
(a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
spt
    where
    spt :: (a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
spt a -> Bool
p ( [a]
pre, a
x:[a]
xs )
      | a -> Bool
p a
x         = forall (m :: * -> *) a. Monad m => a -> m a
return [ ( a
x, (a
xforall a. a -> [a] -> [a]
:[a]
pre, [a]
xs) ) ]
      | Bool
otherwise   = forall (m :: * -> *) a. Monad m => a -> m a
return []
    spt a -> Bool
_ ( [a]
_, [] ) = forall (m :: * -> *) a. Monad m => a -> m a
return []
  spotBack :: (a -> Bool) -> ParseT a m a
spotBack = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {a}.
Monad m =>
(a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
sptbck
    where
    sptbck :: (a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
sptbck a -> Bool
p ( a
x:[a]
xs, [a]
post )
      | a -> Bool
p a
x            = forall (m :: * -> *) a. Monad m => a -> m a
return [ ( a
x, ([a]
xs, a
xforall a. a -> [a] -> [a]
:[a]
post) ) ]
      | Bool
otherwise      = forall (m :: * -> *) a. Monad m => a -> m a
return []
    sptbck a -> Bool
_ ( [], [a]
_ ) = forall (m :: * -> *) a. Monad m => a -> m a
return []
  still :: forall b. ParseT a m b -> ParseT a m b
still ParseT a m b
p = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do
    [(b, ([a], [a]))]
rets <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
p ([a], [a])
inp
    forall (m :: * -> *) a. Monad m => a -> m a
return [ ( b
ret, ([a], [a])
inp ) | ( b
ret, ([a], [a])
_ ) <- [(b, ([a], [a]))]
rets ]
  parseNot :: forall c b. c -> ParseT a m b -> ParseT a m c
parseNot c
x ( ParseT ([a], [a]) -> m [(b, ([a], [a]))]
p ) = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do
    [(b, ([a], [a]))]
rets <- ([a], [a]) -> m [(b, ([a], [a]))]
p ([a], [a])
inp
    case [(b, ([a], [a]))]
rets of
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return [ (c
x, ([a], [a])
inp) ]
      [(b, ([a], [a]))]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  getHere :: ParseT a m ([a], [a])
getHere = forall s (m :: * -> *). MonadState s m => m s
get
  putHere :: ([a], [a]) -> ParseT a m ()
putHere = forall s (m :: * -> *). MonadState s m => s -> m ()
put
  noBacktrack :: forall b. ParseT a m b -> ParseT a m b
noBacktrack ParseT a m b
p = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do [(b, ([a], [a]))]
ret <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
p ([a], [a])
inp
                                      forall (m :: * -> *) a. Monad m => a -> m a
return [ forall a. [a] -> a
head [(b, ([a], [a]))]
ret ]

instance Monad m => MonadReader ( [a], [a] ) ( ParseT a m ) where
  ask :: ParseT a m ([a], [a])
ask       = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> forall (m :: * -> *) a. Monad m => a -> m a
return [ (([a], [a])
inp, ([a], [a])
inp) ]
  local :: forall a.
(([a], [a]) -> ([a], [a])) -> ParseT a m a -> ParseT a m a
local ([a], [a]) -> ([a], [a])
f ParseT a m a
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
f

instance Monad m => MonadState ( [a], [a] ) ( ParseT a m ) where
  get :: ParseT a m ([a], [a])
get     = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> forall (m :: * -> *) a. Monad m => a -> m a
return [ (([a], [a])
inp, ([a], [a])
inp) ]
  put :: ([a], [a]) -> ParseT a m ()
put ([a], [a])
inp = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return [ ((), ([a], [a])
inp) ]

instance MonadTrans ( ParseT a ) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ParseT a m a
lift m a
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> do
             a
ret <- m a
m
	     forall (m :: * -> *) a. Monad m => a -> m a
return [ (a
ret, ([a], [a])
a) ]

instance MonadIO m => MonadIO ( ParseT a m ) where
  liftIO :: forall a. IO a -> ParseT a m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadWriter w m => MonadWriter w ( ParseT a m ) where
  tell :: w -> ParseT a m ()
tell     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. ParseT a m a -> ParseT a m (a, w)
listen ParseT a m a
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do
    ( [(a, ([a], [a]))]
al, w
w ) <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ( forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m ([a], [a])
inp )
    forall (m :: * -> *) a. Monad m => a -> m a
return [ ( (a
ret, w
w), ([a], [a])
inp' ) | ( a
ret, ([a], [a])
inp' ) <- [(a, ([a], [a]))]
al ]
  pass :: forall a. ParseT a m (a, w -> w) -> ParseT a m a
pass ParseT a m (a, w -> w)
m   = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall a b. (a -> b) -> a -> b
$ do
    [((a, w -> w), ([a], [a]))]
al <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m (a, w -> w)
m ([a], [a])
inp
    forall (m :: * -> *) a. Monad m => a -> m a
return
      ( [ ( a
ret, ([a], [a])
inp' ) | ( (a
ret, w -> w
_), ([a], [a])
inp' ) <- [((a, w -> w), ([a], [a]))]
al ] ,
        forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [((a, w -> w), ([a], [a]))]
al )

evalParseT :: ( Monad m ) => ParseT a m b -> ( [a], [a] ) -> m [ b ]
evalParseT :: forall (m :: * -> *) a b.
Monad m =>
ParseT a m b -> ([a], [a]) -> m [b]
evalParseT ParseT a m b
m ([a], [a])
inp = do
  [(b, ([a], [a]))]
al <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m ([a], [a])
inp
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(b, ([a], [a]))]
al

execParseT
  :: ( Monad m ) => ParseT a m b -> ( [a], [a] ) -> m [ ([a], [a]) ]
execParseT :: forall (m :: * -> *) a b.
Monad m =>
ParseT a m b -> ([a], [a]) -> m [([a], [a])]
execParseT ParseT a m b
m ([a], [a])
inp = do
  [(b, ([a], [a]))]
al <- forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m ([a], [a])
inp
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(b, ([a], [a]))]
al

mapParseT
  :: ( m [ ( b, ([a], [a]) ) ] -> n [ (c, ( [a], [a]) ) ] )
       -> ParseT a m b -> ParseT a n c
mapParseT :: forall (m :: * -> *) b a (n :: * -> *) c.
(m [(b, ([a], [a]))] -> n [(c, ([a], [a]))])
-> ParseT a m b -> ParseT a n c
mapParseT m [(b, ([a], [a]))] -> n [(c, ([a], [a]))]
f ParseT a m b
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ m [(b, ([a], [a]))] -> n [(c, ([a], [a]))]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m

withParseT :: ( ([a], [a]) -> ([a], [a]) ) -> ParseT a m b
                                           -> ParseT a m b
withParseT :: forall a (m :: * -> *) b.
(([a], [a]) -> ([a], [a])) -> ParseT a m b -> ParseT a m b
withParseT ([a], [a]) -> ([a], [a])
f ParseT a m b
m = forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> ([a], [a])
f

-- MonadParse instance for other monad transformers

instance ( MonadParse a m ) => MonadParse a ( ReaderT s m ) where
  spot :: (a -> Bool) -> ReaderT s m a
spot         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> ReaderT s m a
spotBack     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. ReaderT s m b -> ReaderT s m b
still        = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still
  parseNot :: forall c b. c -> ReaderT s m b -> ReaderT s m c
parseNot c
x ReaderT s m b
p = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \s
r -> forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot c
x ( forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT s m b
p s
r )
  getHere :: ReaderT s m ([a], [a])
getHere      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> ReaderT s m ()
putHere      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. ReaderT s m b -> ReaderT s m b
noBacktrack  = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack

instance ( MonadParse a m, Monoid w ) => MonadParse a ( WriterT w m )
  where
  spot :: (a -> Bool) -> WriterT w m a
spot        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> WriterT w m a
spotBack    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. WriterT w m b -> WriterT w m b
still       = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still
  parseNot :: forall c b. c -> WriterT w m b -> WriterT w m c
parseNot c
x  = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot (c
x, forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
  getHere :: WriterT w m ([a], [a])
getHere     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> WriterT w m ()
putHere     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. WriterT w m b -> WriterT w m b
noBacktrack = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack

instance ( MonadParse a m ) => MonadParse a ( StateT r m ) where
  spot :: (a -> Bool) -> StateT r m a
spot         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> StateT r m a
spotBack     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. StateT r m b -> StateT r m b
still        = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still
  parseNot :: forall c b. c -> StateT r m b -> StateT r m c
parseNot c
x StateT r m b
p = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \r
s -> forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot ( c
x, r
s ) ( forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT r m b
p r
s )
  getHere :: StateT r m ([a], [a])
getHere      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> StateT r m ()
putHere      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. StateT r m b -> StateT r m b
noBacktrack  = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack