Skip to content

Change MonadState instance #187

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 18, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,11 @@ Breaking changes:
* `noneOf`
* `noneOfCodePoints`
from `Parsing.String` to `Parsing.String.Basic`. (#183 by @jamesdbrock)
- Change MonadState instance (#187 by jamesdbrock)

Users who stack a `ParserT` on a `StateT` base monad will call the `MonadState` members directly like `get` instead of needing to do `lift <<< get`.

To get the `ParserT` internal state, call `getParserT` instead of `get`.

New features:

Expand Down
37 changes: 26 additions & 11 deletions src/Parsing.purs
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@ module Parsing
, failWithPosition
, region
, ParseState(..)
, stateParserT
, getParserT
, hoistParserT
, mapParserT
) where
Expand All @@ -32,8 +34,8 @@ import Control.Apply (lift2)
import Control.Lazy (class Lazy)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, throwError)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Control.Monad.State.Class (class MonadState, gets, modify_)
import Control.Monad.Trans.Class (class MonadTrans)
import Control.Monad.State.Class (class MonadState, state)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.MonadPlus (class Alternative, class MonadPlus, class Plus)
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn2, Fn5, mkFn2, mkFn3, mkFn5, runFn2, runFn3, runFn5)
Expand Down Expand Up @@ -273,12 +275,8 @@ instance MonadRec (ParserT s m) where
runFn3 loop state1 initArg 30
)

instance MonadState (ParseState s) (ParserT s m) where
state k = ParserT
( mkFn5 \state1 _ _ _ done -> do
let (Tuple a state2) = k state1
runFn2 done state2 a
)
instance (MonadState t m) => MonadState t (ParserT s m) where
state k = lift (state k)

instance MonadThrow ParseError (ParserT s m) where
throwError err = ParserT
Expand Down Expand Up @@ -360,18 +358,35 @@ instance MonadTrans (ParserT s) where
lift' $ map (\a _ -> runFn2 done state1 a) m
)

-- | Query and modify the `ParserT` internal state.
-- |
-- | Like the `state` member of `MonadState`.
stateParserT :: forall s m a. (ParseState s -> Tuple a (ParseState s)) -> ParserT s m a
stateParserT k = ParserT
( mkFn5 \state1 _ _ _ done -> do
let (Tuple a state2) = k state1
runFn2 done state2 a
)

-- | Query the `ParserT` internal state.
-- |
-- | Like the `get` member of `MonadState`.
getParserT :: forall s m. ParserT s m (ParseState s)
getParserT = ParserT
( mkFn5 \state1 _ _ _ done -> runFn2 done state1 state1
)

-- | Set the consumed flag.
-- |
-- | Setting the consumed flag means that we're committed to this parsing branch
-- | of an alternative (`<|>`), so that if this branch fails then we want to
-- | fail the entire parse instead of trying the other alternative.
consume :: forall s m. ParserT s m Unit
consume = modify_ \(ParseState input pos _) ->
ParseState input pos true
consume = stateParserT \(ParseState input pos _) -> Tuple unit (ParseState input pos true)

-- | Returns the current position in the stream.
position :: forall s m. ParserT s m Position
position = gets \(ParseState _ pos _) -> pos
position = stateParserT \state1@(ParseState _ pos _) -> Tuple pos state1

-- | Fail with a message.
fail :: forall m s a. String -> ParserT s m a
Expand Down
11 changes: 5 additions & 6 deletions src/Parsing/String.purs
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,6 @@ module Parsing.String
import Prelude hiding (between)

import Control.Monad.Rec.Class (Step(..), tailRecM)
import Control.Monad.State (get)
import Data.Array.NonEmpty as NonEmptyArray
import Data.Either (Either(..))
import Data.Enum (fromEnum, toEnum)
Expand All @@ -64,7 +63,7 @@ import Data.String.CodeUnits as SCU
import Data.String.Regex as Regex
import Data.String.Regex.Flags (RegexFlags)
import Data.Tuple (Tuple(..))
import Parsing (ParseError(..), ParseState(..), ParserT(..), Position(..))
import Parsing (ParseError(..), ParseState(..), ParserT(..), Position(..), getParserT)
import Parsing.Combinators (alt, try, (<?>))
import Partial.Unsafe (unsafePartial)

Expand Down Expand Up @@ -195,9 +194,9 @@ updatePosSingle (Position { index, line, column }) cp after = case fromEnum cp o
-- | ```
match :: forall m a. ParserT String m a -> ParserT String m (Tuple String a)
match p = do
ParseState input1 _ _ <- get
ParseState input1 _ _ <- getParserT
x <- p
ParseState input2 _ _ <- get
ParseState input2 _ _ <- getParserT
-- We use the `SCU.length`, which is in units of “code units”
-- instead of `Data.String.length`. which is in units of “code points”.
-- This is more efficient, and it will be correct as long as we can assume
Expand Down Expand Up @@ -300,13 +299,13 @@ anyTill
=> ParserT String m a
-> ParserT String m (Tuple String a)
anyTill p = do
ParseState input1 _ _ <- get
ParseState input1 _ _ <- getParserT
Tuple input2 t <- tailRecM go unit
pure $ Tuple (SCU.take (SCU.length input1 - SCU.length input2) input1) t
where
go unit = alt
( do
ParseState input2 _ _ <- get
ParseState input2 _ _ <- getParserT
t <- try p
pure $ Done $ Tuple input2 t
)
Expand Down
10 changes: 4 additions & 6 deletions src/Parsing/Token.purs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,6 @@ module Parsing.Token
import Prelude hiding (between, when)

import Control.Lazy (fix)
import Control.Monad.State (get, gets, modify_)
import Control.MonadPlus (guard, (<|>))
import Data.Array as Array
import Data.Char (fromCharCode, toCharCode)
Expand All @@ -43,7 +42,7 @@ import Data.String.CodeUnits (singleton, toChar) as CodeUnits
import Data.String.CodeUnits as SCU
import Data.String.Unicode as Unicode
import Data.Tuple (Tuple(..))
import Parsing (ParseState(..), ParserT, consume, fail)
import Parsing (ParseState(..), ParserT, consume, fail, getParserT, stateParserT)
import Parsing.Combinators (between, choice, notFollowedBy, option, sepBy, sepBy1, skipMany, skipMany1, try, tryRethrow, (<?>), (<??>))
import Parsing.Pos (Position)
import Parsing.String (char, satisfy, satisfyCodePoint, string)
Expand All @@ -53,12 +52,11 @@ import Parsing.String.Basic as Basic
-- | A parser which returns the first token in the stream.
token :: forall m a. (a -> Position) -> ParserT (List a) m a
token tokpos = do
input <- gets \(ParseState input _ _) -> input
ParseState input _ _ <- getParserT
case List.uncons input of
Nothing -> fail "Unexpected EOF"
Just { head, tail } -> do
modify_ \(ParseState _ _ _) ->
ParseState tail (tokpos head) true
stateParserT \(ParseState _ _ _) -> Tuple unit (ParseState tail (tokpos head) true)
pure head

-- | A parser which matches any token satisfying the predicate.
Expand All @@ -75,7 +73,7 @@ match tokpos tok = when tokpos (_ == tok)
-- | Match the “end-of-file,” the end of the input stream.
eof :: forall a m. ParserT (List a) m Unit
eof = do
ParseState input _ _ <- get
ParseState input _ _ <- getParserT
if (List.null input)
-- We must consume so this combines correctly with notFollowedBy
then consume
Expand Down