@@ -21,6 +21,8 @@ module Parsing
21
21
, failWithPosition
22
22
, region
23
23
, ParseState (..)
24
+ , stateParserT
25
+ , getParserT
24
26
, hoistParserT
25
27
, mapParserT
26
28
) where
@@ -32,8 +34,8 @@ import Control.Apply (lift2)
32
34
import Control.Lazy (class Lazy )
33
35
import Control.Monad.Error.Class (class MonadError , class MonadThrow , catchError , throwError )
34
36
import Control.Monad.Rec.Class (class MonadRec , Step (..), tailRecM )
35
- import Control.Monad.State.Class (class MonadState , gets , modify_ )
36
- import Control.Monad.Trans.Class (class MonadTrans )
37
+ import Control.Monad.State.Class (class MonadState , state )
38
+ import Control.Monad.Trans.Class (class MonadTrans , lift )
37
39
import Control.MonadPlus (class Alternative , class MonadPlus , class Plus )
38
40
import Data.Either (Either (..))
39
41
import Data.Function.Uncurried (Fn2 , Fn5 , mkFn2 , mkFn3 , mkFn5 , runFn2 , runFn3 , runFn5 )
@@ -273,12 +275,8 @@ instance MonadRec (ParserT s m) where
273
275
runFn3 loop state1 initArg 30
274
276
)
275
277
276
- instance MonadState (ParseState s ) (ParserT s m ) where
277
- state k = ParserT
278
- ( mkFn5 \state1 _ _ _ done -> do
279
- let (Tuple a state2) = k state1
280
- runFn2 done state2 a
281
- )
278
+ instance (MonadState t m ) => MonadState t (ParserT s m ) where
279
+ state k = lift (state k)
282
280
283
281
instance MonadThrow ParseError (ParserT s m ) where
284
282
throwError err = ParserT
@@ -360,18 +358,35 @@ instance MonadTrans (ParserT s) where
360
358
lift' $ map (\a _ -> runFn2 done state1 a) m
361
359
)
362
360
361
+ -- | Query and modify the `ParserT` internal state.
362
+ -- |
363
+ -- | Like the `state` member of `MonadState`.
364
+ stateParserT :: forall s m a . (ParseState s -> Tuple a (ParseState s )) -> ParserT s m a
365
+ stateParserT k = ParserT
366
+ ( mkFn5 \state1 _ _ _ done -> do
367
+ let (Tuple a state2) = k state1
368
+ runFn2 done state2 a
369
+ )
370
+
371
+ -- | Query the `ParserT` internal state.
372
+ -- |
373
+ -- | Like the `get` member of `MonadState`.
374
+ getParserT :: forall s m . ParserT s m (ParseState s )
375
+ getParserT = ParserT
376
+ ( mkFn5 \state1 _ _ _ done -> runFn2 done state1 state1
377
+ )
378
+
363
379
-- | Set the consumed flag.
364
380
-- |
365
381
-- | Setting the consumed flag means that we're committed to this parsing branch
366
382
-- | of an alternative (`<|>`), so that if this branch fails then we want to
367
383
-- | fail the entire parse instead of trying the other alternative.
368
384
consume :: forall s m . ParserT s m Unit
369
- consume = modify_ \(ParseState input pos _) ->
370
- ParseState input pos true
385
+ consume = stateParserT \(ParseState input pos _) -> Tuple unit (ParseState input pos true )
371
386
372
387
-- | Returns the current position in the stream.
373
388
position :: forall s m . ParserT s m Position
374
- position = gets \ (ParseState _ pos _) -> pos
389
+ position = stateParserT \state1@ (ParseState _ pos _) -> Tuple pos state1
375
390
376
391
-- | Fail with a message.
377
392
fail :: forall m s a . String -> ParserT s m a
0 commit comments