Merge pull request #187 from purescript-contrib/monadstate

Change MonadState instance

Author: jamesdbrock

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:
 

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

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
     )

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