{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
module Control.Effect.State.Internal
( State(..)
) where

import Control.Effect.Class
import GHC.Generics (Generic1)

-- | @since 0.1.0.0
data State s m k
  = Get (s -> m k)
  | Put s (m k)
  deriving (a -> State s m b -> State s m a
(a -> b) -> State s m a -> State s m b
(forall a b. (a -> b) -> State s m a -> State s m b)
-> (forall a b. a -> State s m b -> State s m a)
-> Functor (State s m)
forall a b. a -> State s m b -> State s m a
forall a b. (a -> b) -> State s m a -> State s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> State s m b -> State s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> State s m a -> State s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> State s m b -> State s m a
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> State s m b -> State s m a
fmap :: (a -> b) -> State s m a -> State s m b
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> State s m a -> State s m b
Functor, (forall a. State s m a -> Rep1 (State s m) a)
-> (forall a. Rep1 (State s m) a -> State s m a)
-> Generic1 (State s m)
forall a. Rep1 (State s m) a -> State s m a
forall a. State s m a -> Rep1 (State s m) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall s (m :: * -> *) a. Rep1 (State s m) a -> State s m a
forall s (m :: * -> *) a. State s m a -> Rep1 (State s m) a
$cto1 :: forall s (m :: * -> *) a. Rep1 (State s m) a -> State s m a
$cfrom1 :: forall s (m :: * -> *) a. State s m a -> Rep1 (State s m) a
Generic1)

instance HFunctor (State s)
instance Effect   (State s)