From ed85e624c3c854bae44dbb54fcecfdc8448f4107 Mon Sep 17 00:00:00 2001 From: James Brock Date: Sun, 17 Apr 2022 02:01:36 +0900 Subject: [PATCH] Change MonadState instance `state` refers to base monad instead of `ParseState` --- CHANGELOG.md | 5 +++++ src/Parsing.purs | 37 ++++++++++++++++++++++++++----------- src/Parsing/String.purs | 11 +++++------ src/Parsing/Token.purs | 10 ++++------ 4 files changed, 40 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b176f6b..a393d50 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: diff --git a/src/Parsing.purs b/src/Parsing.purs index 0ca63d3..ceba3e6 100644 --- a/src/Parsing.purs +++ b/src/Parsing.purs @@ -21,6 +21,8 @@ module Parsing , failWithPosition , region , ParseState(..) + , stateParserT + , getParserT , hoistParserT , mapParserT ) where @@ -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) @@ -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 @@ -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 diff --git a/src/Parsing/String.purs b/src/Parsing/String.purs index 94b380c..9dc6875 100644 --- a/src/Parsing/String.purs +++ b/src/Parsing/String.purs @@ -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) @@ -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) @@ -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 @@ -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 ) diff --git a/src/Parsing/Token.purs b/src/Parsing/Token.purs index 93104b6..b502450 100644 --- a/src/Parsing/Token.purs +++ b/src/Parsing/Token.purs @@ -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) @@ -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) @@ -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. @@ -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