--
-- 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 = (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot     (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)
tokenBack :: forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
tokenBack a
x = (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack (a -> a -> Bool
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 = (([a], [a]) -> b) -> m ([a], [a]) -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([a], [a]) -> b
f m ([a], [a])
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 = m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere m ([a], [a]) -> (([a], [a]) -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere (([a], [a]) -> m ())
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> m ()
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       = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst
getForward :: forall a (m :: * -> *). MonadParse a m => m [a]
getForward    = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ([a], [a]) -> [a]
forall a b. (a, b) -> b
snd
getsBack :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m [a]
getsBack    [a] -> [a]
f = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ( [a] -> [a]
f([a] -> [a]) -> (([a], [a]) -> [a]) -> ([a], [a]) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([a], [a]) -> [a]
forall a b. (a, b) -> a
fst )
getsForward :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m [a]
getsForward [a] -> [a]
f = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ( [a] -> [a]
f([a] -> [a]) -> (([a], [a]) -> [a]) -> ([a], [a]) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([a], [a]) -> [a]
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  = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ([a], [a]) -> [a]
forall a b. (a, b) -> b
snd m [a] -> ([a] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere (([a], [a]) -> m ()) -> ([a] -> ([a], [a])) -> [a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [a]
b
putForward :: forall a (m :: * -> *). MonadParse a m => [a] -> m ()
putForward [a]
f  = (([a], [a]) -> [a]) -> m [a]
forall a (m :: * -> *) b.
MonadParse a m =>
(([a], [a]) -> b) -> m b
getsHere ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst m [a] -> ([a] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere (([a], [a]) -> m ()) -> ([a] -> ([a], [a])) -> [a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> ([a], [a])) -> [a] -> [a] -> ([a], [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a]
f
modifyBack :: forall a (m :: * -> *). MonadParse a m => ([a] -> [a]) -> m ()
modifyBack    = (([a], [a]) -> ([a], [a])) -> m ()
forall a (m :: * -> *).
MonadParse a m =>
(([a], [a]) -> ([a], [a])) -> m ()
modifyHere ((([a], [a]) -> ([a], [a])) -> m ())
-> (([a] -> [a]) -> ([a], [a]) -> ([a], [a]))
-> ([a] -> [a])
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall b c d. (b -> c) -> (b, d) -> (c, d)
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 = (([a], [a]) -> ([a], [a])) -> m ()
forall a (m :: * -> *).
MonadParse a m =>
(([a], [a]) -> ([a], [a])) -> m ()
modifyHere ((([a], [a]) -> ([a], [a])) -> m ())
-> (([a] -> [a]) -> ([a], [a]) -> ([a], [a]))
-> ([a] -> [a])
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall b c d. (b -> c) -> (d, b) -> (d, 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 = (([p], [p]) -> [(b, ([p], [p]))]) -> Parse p b
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([p], [p]) -> [(b, ([p], [p]))]) -> Parse p b)
-> (([p], [p]) -> [(b, ([p], [p]))]) -> Parse p b
forall a b. (a -> b) -> a -> b
$ ((a, ([p], [p])) -> (b, ([p], [p])))
-> [(a, ([p], [p]))] -> [(b, ([p], [p]))]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ( (a -> b) -> (a, ([p], [p])) -> (b, ([p], [p]))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f ) ([(a, ([p], [p]))] -> [(b, ([p], [p]))])
-> (([p], [p]) -> [(a, ([p], [p]))])
-> ([p], [p])
-> [(b, ([p], [p]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse p a -> ([p], [p]) -> [(a, ([p], [p]))]
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 = a -> Parse p a
forall a. a -> Parse p a
forall (m :: * -> *) a. Monad m => a -> m a
return; <*> :: forall a b. Parse p (a -> b) -> Parse p a -> Parse p 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 = Parse p a
forall a. Parse p a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. Parse p a -> Parse p a -> Parse p a
(<|>) = Parse p a -> Parse p a -> Parse p a
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 = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> (a -> ([a], [a]) -> [(a, ([a], [a]))]) -> a -> Parse a a
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
         = (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ( \([a], [a])
st -> [[(b, ([a], [a]))]] -> [(b, ([a], [a]))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	     [ Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
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                     = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (a -> b) -> a -> b
$ [(a, ([a], [a]))] -> ([a], [a]) -> [(a, ([a], [a]))]
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 = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> ([a], [a]) -> [(a, ([a], [a]))]
p1 ([a], [a])
inp [(a, ([a], [a]))] -> [(a, ([a], [a]))] -> [(a, ([a], [a]))]
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       = (([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a])
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a]))
-> (([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a])
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 = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (a -> b) -> a -> b
$ Parse a a -> ([a], [a]) -> [(a, ([a], [a]))]
forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a a
m (([a], [a]) -> [(a, ([a], [a]))])
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [(a, ([a], [a]))]
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     = (([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a])
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a]))
-> (([a], [a]) -> [(([a], [a]), ([a], [a]))]) -> Parse a ([a], [a])
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 = (([a], [a]) -> [((), ([a], [a]))]) -> Parse a ()
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [((), ([a], [a]))]) -> Parse a ())
-> (([a], [a]) -> [((), ([a], [a]))]) -> Parse a ()
forall a b. (a -> b) -> a -> b
$ [((), ([a], [a]))] -> ([a], [a]) -> [((), ([a], [a]))]
forall a b. a -> b -> a
const [ ((), ([a], [a])
inp) ]

instance MonadParse a ( Parse a ) where
  spot :: (a -> Bool) -> Parse a a
spot = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> ((a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))])
-> (a -> Bool)
-> Parse a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pre, [a]
xs) ) ]
      | Bool
otherwise   = []
    spt a -> Bool
_ ( [a]
_, [] ) = []
  spotBack :: (a -> Bool) -> Parse a a
spotBack = (([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(a, ([a], [a]))]) -> Parse a a)
-> ((a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))])
-> (a -> Bool)
-> Parse a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> ([a], [a]) -> [(a, ([a], [a]))]
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
xa -> [a] -> [a]
forall 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 = (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b)
-> (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do ( b
ret, ([a], [a])
_ ) <- Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
p ([a], [a])
inp
                               (b, ([a], [a])) -> [(b, ([a], [a]))]
forall a. a -> [a]
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 ) = (([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c)
-> (([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c
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 = Parse a ([a], [a])
forall s (m :: * -> *). MonadState s m => m s
get
  putHere :: ([a], [a]) -> Parse a ()
putHere = ([a], [a]) -> Parse a ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  noBacktrack :: forall b. Parse a b -> Parse a b
noBacktrack Parse a b
p = (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b)
-> (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (a -> b) -> a -> b
$ ((b, ([a], [a])) -> [(b, ([a], [a]))] -> [(b, ([a], [a]))]
forall a. a -> [a] -> [a]
:[]) ((b, ([a], [a])) -> [(b, ([a], [a]))])
-> (([a], [a]) -> (b, ([a], [a])))
-> ([a], [a])
-> [(b, ([a], [a]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, ([a], [a]))] -> (b, ([a], [a]))
forall a. HasCallStack => [a] -> a
head ([(b, ([a], [a]))] -> (b, ([a], [a])))
-> (([a], [a]) -> [(b, ([a], [a]))])
-> ([a], [a])
-> (b, ([a], [a]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
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 = ((b, ([a], [a])) -> b) -> [(b, ([a], [a]))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> b
forall a b. (a, b) -> a
fst ([(b, ([a], [a]))] -> [b])
-> (([a], [a]) -> [(b, ([a], [a]))]) -> ([a], [a]) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
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 = ((b, ([a], [a])) -> ([a], [a]))
-> [(b, ([a], [a]))] -> [([a], [a])]
forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> ([a], [a])
forall a b. (a, b) -> b
snd ([(b, ([a], [a]))] -> [([a], [a])])
-> (([a], [a]) -> [(b, ([a], [a]))]) -> ([a], [a]) -> [([a], [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
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 = (([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c)
-> (([a], [a]) -> [(c, ([a], [a]))]) -> Parse a c
forall a b. (a -> b) -> a -> b
$ ((b, ([a], [a])) -> (c, ([a], [a])))
-> [(b, ([a], [a]))] -> [(c, ([a], [a]))]
forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> (c, ([a], [a]))
f ([(b, ([a], [a]))] -> [(c, ([a], [a]))])
-> (([a], [a]) -> [(b, ([a], [a]))])
-> ([a], [a])
-> [(c, ([a], [a]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
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 = (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
Parse ((([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b)
-> (([a], [a]) -> [(b, ([a], [a]))]) -> Parse a b
forall a b. (a -> b) -> a -> b
$ Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse Parse a b
m (([a], [a]) -> [(b, ([a], [a]))])
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [(b, ([a], [a]))]
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 = (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b)
-> (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> do
               [(a, ([a], [a]))]
rets <- ParseT a m a -> ([a], [a]) -> m [(a, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m ([a], [a])
a
	       [(b, ([a], [a]))] -> m [(b, ([a], [a]))]
forall a. a -> m 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 = a -> ParseT a m a
forall a. a -> ParseT a m a
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
(<*>) = 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 = ParseT a m a
forall a. ParseT a m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: forall a. ParseT a m a -> ParseT a m a -> ParseT a m a
(<|>) = ParseT a m a -> ParseT a m a -> ParseT a m a
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 = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m 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
    = (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b)
-> (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a b. (a -> b) -> a -> b
$ \([a], [a])
a ->
        ([a], [a]) -> m [(a, ([a], [a]))]
pr ([a], [a])
a m [(a, ([a], [a]))]
-> ([(a, ([a], [a]))] -> m [(b, ([a], [a]))])
-> m [(b, ([a], [a]))]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
	  ([[(b, ([a], [a]))]] -> [(b, ([a], [a]))])
-> m [[(b, ([a], [a]))]] -> m [(b, ([a], [a]))]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[(b, ([a], [a]))]] -> [(b, ([a], [a]))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[(b, ([a], [a]))]] -> m [(b, ([a], [a]))])
-> ([(a, ([a], [a]))] -> m [[(b, ([a], [a]))]])
-> [(a, ([a], [a]))]
-> m [(b, ([a], [a]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, ([a], [a])) -> m [(b, ([a], [a]))])
-> [(a, ([a], [a]))] -> m [[(b, ([a], [a]))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ( \(a
a', ([a], [a])
rest) -> ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
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                       = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a b. (a -> b) -> a -> b
$ m [(a, ([a], [a]))] -> ([a], [a]) -> m [(a, ([a], [a]))]
forall a b. a -> b -> a
const (m [(a, ([a], [a]))] -> ([a], [a]) -> m [(a, ([a], [a]))])
-> m [(a, ([a], [a]))] -> ([a], [a]) -> m [(a, ([a], [a]))]
forall a b. (a -> b) -> a -> b
$ [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
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 = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
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
						    [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, ([a], [a]))] -> m [(a, ([a], [a]))])
-> [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a b. (a -> b) -> a -> b
$ [(a, ([a], [a]))]
ret1 [(a, ([a], [a]))] -> [(a, ([a], [a]))] -> [(a, ([a], [a]))]
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 = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> ((a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))])
-> (a -> Bool)
-> ParseT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
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         = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( a
x, (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pre, [a]
xs) ) ]
      | Bool
otherwise   = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    spt a -> Bool
_ ( [a]
_, [] ) = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  spotBack :: (a -> Bool) -> ParseT a m a
spotBack = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> ((a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))])
-> (a -> Bool)
-> ParseT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> ([a], [a]) -> m [(a, ([a], [a]))]
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            = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( a
x, ([a]
xs, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
post) ) ]
      | Bool
otherwise      = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    sptbck a -> Bool
_ ( [], [a]
_ ) = [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m 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 = (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b)
-> (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do
    [(b, ([a], [a]))]
rets <- ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
p ([a], [a])
inp
    [(b, ([a], [a]))] -> m [(b, ([a], [a]))]
forall a. a -> m a
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 ) = (([a], [a]) -> m [(c, ([a], [a]))]) -> ParseT a m c
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(c, ([a], [a]))]) -> ParseT a m c)
-> (([a], [a]) -> m [(c, ([a], [a]))]) -> ParseT a m c
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
      [] -> [(c, ([a], [a]))] -> m [(c, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (c
x, ([a], [a])
inp) ]
      [(b, ([a], [a]))]
_  -> [(c, ([a], [a]))] -> m [(c, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  getHere :: ParseT a m ([a], [a])
getHere = ParseT a m ([a], [a])
forall s (m :: * -> *). MonadState s m => m s
get
  putHere :: ([a], [a]) -> ParseT a m ()
putHere = ([a], [a]) -> ParseT a m ()
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 = (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b)
-> (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do [(b, ([a], [a]))]
ret <- ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
p ([a], [a])
inp
                                      [(b, ([a], [a]))] -> m [(b, ([a], [a]))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ [(b, ([a], [a]))] -> (b, ([a], [a]))
forall a. HasCallStack => [a] -> a
head [(b, ([a], [a]))]
ret ]

instance Monad m => MonadReader ( [a], [a] ) ( ParseT a m ) where
  ask :: ParseT a m ([a], [a])
ask       = (([a], [a]) -> m [(([a], [a]), ([a], [a]))])
-> ParseT a m ([a], [a])
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(([a], [a]), ([a], [a]))])
 -> ParseT a m ([a], [a]))
-> (([a], [a]) -> m [(([a], [a]), ([a], [a]))])
-> ParseT a m ([a], [a])
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> [(([a], [a]), ([a], [a]))] -> m [(([a], [a]), ([a], [a]))]
forall a. a -> m a
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 = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a b. (a -> b) -> a -> b
$ ParseT a m a -> ([a], [a]) -> m [(a, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m (([a], [a]) -> m [(a, ([a], [a]))])
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> m [(a, ([a], [a]))]
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     = (([a], [a]) -> m [(([a], [a]), ([a], [a]))])
-> ParseT a m ([a], [a])
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(([a], [a]), ([a], [a]))])
 -> ParseT a m ([a], [a]))
-> (([a], [a]) -> m [(([a], [a]), ([a], [a]))])
-> ParseT a m ([a], [a])
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> [(([a], [a]), ([a], [a]))] -> m [(([a], [a]), ([a], [a]))]
forall a. a -> m a
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 = (([a], [a]) -> m [((), ([a], [a]))]) -> ParseT a m ()
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [((), ([a], [a]))]) -> ParseT a m ())
-> (([a], [a]) -> m [((), ([a], [a]))]) -> ParseT a m ()
forall a b. (a -> b) -> a -> b
$ \([a], [a])
_   -> [((), ([a], [a]))] -> m [((), ([a], [a]))]
forall a. a -> m 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 = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a b. (a -> b) -> a -> b
$ \([a], [a])
a -> do
             a
ret <- m a
m
	     [(a, ([a], [a]))] -> m [(a, ([a], [a]))]
forall a. a -> m a
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 = m a -> ParseT a m a
forall (m :: * -> *) a. Monad m => m a -> ParseT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParseT a m a) -> (IO a -> m a) -> IO a -> ParseT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
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     = m () -> ParseT a m ()
forall (m :: * -> *) a. Monad m => m a -> ParseT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParseT a m ()) -> (w -> m ()) -> w -> ParseT a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
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 = (([a], [a]) -> m [((a, w), ([a], [a]))]) -> ParseT a m (a, w)
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [((a, w), ([a], [a]))]) -> ParseT a m (a, w))
-> (([a], [a]) -> m [((a, w), ([a], [a]))]) -> ParseT a m (a, w)
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> do
    ( [(a, ([a], [a]))]
al, w
w ) <- m [(a, ([a], [a]))] -> m ([(a, ([a], [a]))], w)
forall a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ( ParseT a m a -> ([a], [a]) -> m [(a, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m a
m ([a], [a])
inp )
    [((a, w), ([a], [a]))] -> m [((a, w), ([a], [a]))]
forall a. a -> m a
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   = (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a)
-> (([a], [a]) -> m [(a, ([a], [a]))]) -> ParseT a m a
forall a b. (a -> b) -> a -> b
$ \([a], [a])
inp -> m ([(a, ([a], [a]))], w -> w) -> m [(a, ([a], [a]))]
forall a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m ([(a, ([a], [a]))], w -> w) -> m [(a, ([a], [a]))])
-> m ([(a, ([a], [a]))], w -> w) -> m [(a, ([a], [a]))]
forall a b. (a -> b) -> a -> b
$ do
    [((a, w -> w), ([a], [a]))]
al <- ParseT a m (a, w -> w)
-> ([a], [a]) -> m [((a, w -> w), ([a], [a]))]
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
    ([(a, ([a], [a]))], w -> w) -> m ([(a, ([a], [a]))], w -> w)
forall a. a -> m a
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 ] ,
        (a, w -> w) -> w -> w
forall a b. (a, b) -> b
snd ((a, w -> w) -> w -> w)
-> (((a, w -> w), ([a], [a])) -> (a, w -> w))
-> ((a, w -> w), ([a], [a]))
-> w
-> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, w -> w), ([a], [a])) -> (a, w -> w)
forall a b. (a, b) -> a
fst (((a, w -> w), ([a], [a])) -> w -> w)
-> ((a, w -> w), ([a], [a])) -> w -> w
forall a b. (a -> b) -> a -> b
$ [((a, w -> w), ([a], [a]))] -> ((a, w -> w), ([a], [a]))
forall a. HasCallStack => [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 <- ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m ([a], [a])
inp
  [b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ ((b, ([a], [a])) -> b) -> [(b, ([a], [a]))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> b
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 <- ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m ([a], [a])
inp
  [([a], [a])] -> m [([a], [a])]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([([a], [a])] -> m [([a], [a])]) -> [([a], [a])] -> m [([a], [a])]
forall a b. (a -> b) -> a -> b
$ ((b, ([a], [a])) -> ([a], [a]))
-> [(b, ([a], [a]))] -> [([a], [a])]
forall a b. (a -> b) -> [a] -> [b]
map (b, ([a], [a])) -> ([a], [a])
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 = (([a], [a]) -> n [(c, ([a], [a]))]) -> ParseT a n c
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> n [(c, ([a], [a]))]) -> ParseT a n c)
-> (([a], [a]) -> n [(c, ([a], [a]))]) -> ParseT a n c
forall a b. (a -> b) -> a -> b
$ m [(b, ([a], [a]))] -> n [(c, ([a], [a]))]
f (m [(b, ([a], [a]))] -> n [(c, ([a], [a]))])
-> (([a], [a]) -> m [(b, ([a], [a]))])
-> ([a], [a])
-> n [(c, ([a], [a]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
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 = (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a (m :: * -> *) b.
(([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
ParseT ((([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b)
-> (([a], [a]) -> m [(b, ([a], [a]))]) -> ParseT a m b
forall a b. (a -> b) -> a -> b
$ ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
forall a (m :: * -> *) b.
ParseT a m b -> ([a], [a]) -> m [(b, ([a], [a]))]
runParseT ParseT a m b
m (([a], [a]) -> m [(b, ([a], [a]))])
-> (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> m [(b, ([a], [a]))]
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         = m a -> ReaderT s m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT s m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> ReaderT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> ReaderT s m a
spotBack     = m a -> ReaderT s m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT s m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> ReaderT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. ReaderT s m b -> ReaderT s m b
still        = (m b -> m b) -> ReaderT s m b -> ReaderT s m b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m b -> m b
forall b. m b -> m b
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 = (s -> m c) -> ReaderT s m c
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((s -> m c) -> ReaderT s m c) -> (s -> m c) -> ReaderT s m c
forall a b. (a -> b) -> a -> b
$ \s
r -> c -> m b -> m c
forall c b. c -> m b -> m c
forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot c
x ( ReaderT s m b -> s -> m b
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      = m ([a], [a]) -> ReaderT s m ([a], [a])
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> ReaderT s m ()
putHere      = m () -> ReaderT s m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT s m ())
-> (([a], [a]) -> m ()) -> ([a], [a]) -> ReaderT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. ReaderT s m b -> ReaderT s m b
noBacktrack  = (m b -> m b) -> ReaderT s m b -> ReaderT s m b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m b -> m b
forall b. m b -> m b
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        = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> WriterT w m a
spotBack    = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. WriterT w m b -> WriterT w m b
still       = (m (b, w) -> m (b, w)) -> WriterT w m b -> WriterT w m b
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT m (b, w) -> m (b, w)
forall b. m b -> m b
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  = m (c, w) -> WriterT w m c
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (c, w) -> WriterT w m c)
-> (WriterT w m b -> m (c, w)) -> WriterT w m b -> WriterT w m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, w) -> m (b, w) -> m (c, w)
forall c b. c -> m b -> m c
forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot (c
x, w
forall a. Monoid a => a
mempty) (m (b, w) -> m (c, w))
-> (WriterT w m b -> m (b, w)) -> WriterT w m b -> m (c, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
  getHere :: WriterT w m ([a], [a])
getHere     = m ([a], [a]) -> WriterT w m ([a], [a])
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> WriterT w m ()
putHere     = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ())
-> (([a], [a]) -> m ()) -> ([a], [a]) -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. WriterT w m b -> WriterT w m b
noBacktrack = (m (b, w) -> m (b, w)) -> WriterT w m b -> WriterT w m b
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT m (b, w) -> m (b, w)
forall b. m b -> m b
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         = m a -> StateT r m a
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT r m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> StateT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot
  spotBack :: (a -> Bool) -> StateT r m a
spotBack     = m a -> StateT r m a
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT r m a)
-> ((a -> Bool) -> m a) -> (a -> Bool) -> StateT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> m a
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack
  still :: forall b. StateT r m b -> StateT r m b
still        = (m (b, r) -> m (b, r)) -> StateT r m b -> StateT r m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (b, r) -> m (b, r)
forall b. m b -> m b
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 = (r -> m (c, r)) -> StateT r m c
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((r -> m (c, r)) -> StateT r m c)
-> (r -> m (c, r)) -> StateT r m c
forall a b. (a -> b) -> a -> b
$ \r
s -> (c, r) -> m (b, r) -> m (c, r)
forall c b. c -> m b -> m c
forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot ( c
x, r
s ) ( StateT r m b -> r -> m (b, r)
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      = m ([a], [a]) -> StateT r m ([a], [a])
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ([a], [a])
forall a (m :: * -> *). MonadParse a m => m ([a], [a])
getHere
  putHere :: ([a], [a]) -> StateT r m ()
putHere      = m () -> StateT r m ()
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT r m ())
-> (([a], [a]) -> m ()) -> ([a], [a]) -> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> m ()
forall a (m :: * -> *). MonadParse a m => ([a], [a]) -> m ()
putHere
  noBacktrack :: forall b. StateT r m b -> StateT r m b
noBacktrack  = (m (b, r) -> m (b, r)) -> StateT r m b -> StateT r m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (b, r) -> m (b, r)
forall b. m b -> m b
forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack