{-# LANGUAGE DeriveFunctor, MultiParamTypeClasses, DerivingStrategies, CPP #-} module Parsley.Internal.Common.State ( State, StateT, runState, evalState, execState, runStateT, evalStateT, execStateT, module Control.Monad.State.Class ) where import Control.Applicative (liftA2, Alternative(..)) #if __GLASGOW_HASKELL__ < 808 import Control.Monad.Fail (MonadFail(..)) #endif import Control.Monad.Fix (MonadFix(..)) import Control.Monad.Identity (Identity, runIdentity) import Control.Monad.State.Class import Control.Monad.Trans (MonadTrans(..), MonadIO(..)) #if __GLASGOW_HASKELL__ < 808 import qualified Control.Monad.Fail as Fail (MonadFail(fail)) #endif type State s = StateT s Identity {-# INLINE runState #-} runState :: State s a -> s -> (a, s) runState :: State s a -> s -> (a, s) runState State s a mx = Identity (a, s) -> (a, s) forall a. Identity a -> a runIdentity (Identity (a, s) -> (a, s)) -> (s -> Identity (a, s)) -> s -> (a, s) forall b c a. (b -> c) -> (a -> b) -> a -> c . State s a -> s -> Identity (a, s) forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m (a, s) runStateT State s a mx {-# INLINE evalState #-} evalState :: State s a -> s -> a evalState :: State s a -> s -> a evalState State s a mx = Identity a -> a forall a. Identity a -> a runIdentity (Identity a -> a) -> (s -> Identity a) -> s -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . State s a -> s -> Identity a forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m a evalStateT State s a mx {-# INLINE execState #-} execState :: State s a -> s -> s execState :: State s a -> s -> s execState State s a mx = Identity s -> s forall a. Identity a -> a runIdentity (Identity s -> s) -> (s -> Identity s) -> s -> s forall b c a. (b -> c) -> (a -> b) -> a -> c . State s a -> s -> Identity s forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m s execStateT State s a mx newtype StateT s m a = StateT {StateT s m a -> forall (r :: k). s -> (a -> s -> m r) -> m r unStateT :: forall r. s -> (a -> s -> m r) -> m r} deriving stock a -> StateT s m b -> StateT s m a (a -> b) -> StateT s m a -> StateT s m b (forall a b. (a -> b) -> StateT s m a -> StateT s m b) -> (forall a b. a -> StateT s m b -> StateT s m a) -> Functor (StateT s m) forall a b. a -> StateT s m b -> StateT s m a forall a b. (a -> b) -> StateT s m a -> StateT s m b forall s k (m :: k -> Type) a b. a -> StateT s m b -> StateT s m a forall s k (m :: k -> Type) a b. (a -> b) -> StateT s m a -> StateT s m b forall (f :: Type -> Type). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> StateT s m b -> StateT s m a $c<$ :: forall s k (m :: k -> Type) a b. a -> StateT s m b -> StateT s m a fmap :: (a -> b) -> StateT s m a -> StateT s m b $cfmap :: forall s k (m :: k -> Type) a b. (a -> b) -> StateT s m a -> StateT s m b Functor {-# INLINE runStateT #-} runStateT :: Monad m => StateT s m a -> s -> m (a, s) runStateT :: StateT s m a -> s -> m (a, s) runStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = s -> (a -> s -> m (a, s)) -> m (a, s) forall r. s -> (a -> s -> m r) -> m r f s s (((a, s) -> m (a, s)) -> a -> s -> m (a, s) forall a b c. ((a, b) -> c) -> a -> b -> c curry (a, s) -> m (a, s) forall (m :: Type -> Type) a. Monad m => a -> m a return) {-# INLINE evalStateT #-} evalStateT :: Monad m => StateT s m a -> s -> m a evalStateT :: StateT s m a -> s -> m a evalStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = s -> (a -> s -> m a) -> m a forall r. s -> (a -> s -> m r) -> m r f s s (m a -> s -> m a forall a b. a -> b -> a const (m a -> s -> m a) -> (a -> m a) -> a -> s -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> m a forall (m :: Type -> Type) a. Monad m => a -> m a return) {-# INLINE execStateT #-} execStateT :: Monad m => StateT s m a -> s -> m s execStateT :: StateT s m a -> s -> m s execStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = s -> (a -> s -> m s) -> m s forall r. s -> (a -> s -> m r) -> m r f s s ((s -> m s) -> a -> s -> m s forall a b. a -> b -> a const s -> m s forall (m :: Type -> Type) a. Monad m => a -> m a return) instance Applicative (StateT s m) where {-# INLINE pure #-} pure :: a -> StateT s m a pure a x = (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (((a -> s -> m r) -> s -> m r) -> s -> (a -> s -> m r) -> m r forall a b c. (a -> b -> c) -> b -> a -> c flip ((a -> s -> m r) -> a -> s -> m r forall a b. (a -> b) -> a -> b $ a x)) {-# INLINE liftA2 #-} liftA2 :: (a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c liftA2 a -> b -> c f (StateT forall (r :: k). s -> (a -> s -> m r) -> m r mx) (StateT forall (r :: k). s -> (b -> s -> m r) -> m r my) = (forall (r :: k). s -> (c -> s -> m r) -> m r) -> StateT s m c forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s c -> s -> m r k -> s -> (a -> s -> m r) -> m r forall (r :: k). s -> (a -> s -> m r) -> m r mx s s (\a x s s' -> s -> (b -> s -> m r) -> m r forall (r :: k). s -> (b -> s -> m r) -> m r my s s' (\b y s s'' -> c -> s -> m r k (a -> b -> c f a x b y) s s''))) instance Monad (StateT s m) where {-# INLINE return #-} return :: a -> StateT s m a return = a -> StateT s m a forall (f :: Type -> Type) a. Applicative f => a -> f a pure {-# INLINE (>>=) #-} StateT forall (r :: k). s -> (a -> s -> m r) -> m r mx >>= :: StateT s m a -> (a -> StateT s m b) -> StateT s m b >>= a -> StateT s m b f = (forall (r :: k). s -> (b -> s -> m r) -> m r) -> StateT s m b forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s b -> s -> m r k -> s -> (a -> s -> m r) -> m r forall (r :: k). s -> (a -> s -> m r) -> m r mx s s (\a x s s' -> StateT s m b -> s -> (b -> s -> m r) -> m r forall s k (m :: k -> Type) a. StateT s m a -> forall (r :: k). s -> (a -> s -> m r) -> m r unStateT (a -> StateT s m b f a x) s s' b -> s -> m r k)) instance MonadFix m => MonadFix (StateT s m) where {-# INLINE mfix #-} mfix :: (a -> StateT s m a) -> StateT s m a mfix a -> StateT s m a f = (forall r. s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s a -> s -> m r k -> ((a, s) -> m (a, s)) -> m (a, s) forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a mfix (\ ~(a x, s _) -> StateT s m a -> s -> m (a, s) forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m (a, s) runStateT (a -> StateT s m a f a x) s s) m (a, s) -> ((a, s) -> m r) -> m r forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= (a -> s -> m r) -> (a, s) -> m r forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> s -> m r k) instance MonadTrans (StateT s) where {-# INLINE lift #-} lift :: m a -> StateT s m a lift m a m = (forall r. s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s a -> s -> m r k -> m a m m a -> (a -> m r) -> m r forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= (a -> s -> m r `k` s s)) instance MonadIO m => MonadIO (StateT s m) where liftIO :: IO a -> StateT s m a liftIO = m a -> StateT s m a forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> StateT s m a) -> (IO a -> m a) -> IO a -> StateT s m a forall b c a. (b -> c) -> (a -> b) -> a -> c . IO a -> m a forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO instance MonadFail m => MonadFail (StateT s m) where #if __GLASGOW_HASKELL__ < 808 fail msg = StateT (\_ _ -> Fail.fail msg) #else fail :: String -> StateT s m a fail String msg = (forall r. s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s _ a -> s -> m r _ -> String -> m r forall (m :: Type -> Type) a. MonadFail m => String -> m a fail String msg) #endif instance Alternative m => Alternative (StateT s m) where empty :: StateT s m a empty = (forall r. s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s _ a -> s -> m r _ -> m r forall (f :: Type -> Type) a. Alternative f => f a empty) StateT forall r. s -> (a -> s -> m r) -> m r mx <|> :: StateT s m a -> StateT s m a -> StateT s m a <|> StateT forall r. s -> (a -> s -> m r) -> m r my = (forall r. s -> (a -> s -> m r) -> m r) -> StateT s m a forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s a -> s -> m r k -> s -> (a -> s -> m r) -> m r forall r. s -> (a -> s -> m r) -> m r mx s s a -> s -> m r k m r -> m r -> m r forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a <|> s -> (a -> s -> m r) -> m r forall r. s -> (a -> s -> m r) -> m r my s s a -> s -> m r k) instance MonadState s (StateT s m) where get :: StateT s m s get = (forall (r :: k). s -> (s -> s -> m r) -> m r) -> StateT s m s forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s s s -> s -> m r k -> s -> s -> m r k s s s s) put :: s -> StateT s m () put s s = (forall (r :: k). s -> (() -> s -> m r) -> m r) -> StateT s m () forall k s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (\s _ () -> s -> m r k -> () -> s -> m r k () s s)