{-# 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 :: forall s a. State s a -> s -> (a, s) runState State s a mx = forall a. Identity a -> a runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 :: forall s a. State s a -> s -> a evalState State s a mx = forall a. Identity a -> a runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 :: forall s a. State s a -> s -> s execState State s a mx = forall a. Identity a -> a runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 {forall {k} s (m :: k -> Type) a. 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 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 <$ :: forall a b. 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 :: forall a b. (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 :: forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m (a, s) runStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = forall r. s -> (a -> s -> m r) -> m r f s s (forall a b c. ((a, b) -> c) -> a -> b -> c curry forall (m :: Type -> Type) a. Monad m => a -> m a return) {-# INLINE evalStateT #-} evalStateT :: Monad m => StateT s m a -> s -> m a evalStateT :: forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m a evalStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = forall r. s -> (a -> s -> m r) -> m r f s s (forall a b. a -> b -> a const forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: Type -> Type) a. Monad m => a -> m a return) {-# INLINE execStateT #-} execStateT :: Monad m => StateT s m a -> s -> m s execStateT :: forall (m :: Type -> Type) s a. Monad m => StateT s m a -> s -> m s execStateT (StateT forall r. s -> (a -> s -> m r) -> m r f) s s = forall r. s -> (a -> s -> m r) -> m r f s s (forall a b. a -> b -> a const forall (m :: Type -> Type) a. Monad m => a -> m a return) instance Applicative (StateT s m) where {-# INLINE pure #-} pure :: forall a. a -> StateT s m a pure a x = forall {k} s (m :: k -> Type) a. (forall (r :: k). s -> (a -> s -> m r) -> m r) -> StateT s m a StateT (forall a b c. (a -> b -> c) -> b -> a -> c flip (forall a b. (a -> b) -> a -> b $ a x)) {-# INLINE liftA2 #-} liftA2 :: forall a b c. (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 {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 -> forall (r :: k). s -> (a -> s -> m r) -> m r mx s s (\a x s s' -> forall (r :: k). s -> (b -> s -> m r) -> m r my s s' (c -> s -> m r k forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> b -> c f a x))) instance Monad (StateT s m) where {-# INLINE return #-} return :: forall a. a -> StateT s m a return = forall (f :: Type -> Type) a. Applicative f => a -> f a pure {-# INLINE (>>=) #-} StateT forall (r :: k). s -> (a -> s -> m r) -> m r mx >>= :: forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b >>= a -> StateT s m b f = 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 -> forall (r :: k). s -> (a -> s -> m r) -> m r mx s s (\a x s s' -> forall {k} s (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 :: forall a. (a -> StateT s m a) -> StateT s m a mfix a -> StateT s m a f = 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 -> forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a mfix (\ ~(a x, 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) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> s -> m r k) instance MonadTrans (StateT s) where {-# INLINE lift #-} lift :: forall (m :: Type -> Type) a. Monad m => m a -> StateT s m a lift m a 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 a -> s -> m r k -> m a m 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 :: forall a. IO a -> StateT s m a liftIO = forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 :: forall a. String -> StateT s m a fail String msg = 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 _ -> forall (m :: Type -> Type) a. MonadFail m => String -> m a fail String msg) #endif instance Alternative m => Alternative (StateT s m) where empty :: forall a. StateT s m a empty = 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 _ -> forall (f :: Type -> Type) a. Alternative f => f a empty) StateT forall r. s -> (a -> s -> m r) -> m r mx <|> :: forall a. StateT s m a -> StateT s m a -> StateT s m a <|> StateT forall r. s -> (a -> s -> m r) -> m r my = 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 -> forall r. s -> (a -> s -> m r) -> m r mx s s a -> s -> m r k forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a <|> 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 {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 {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)