Update Control.Carrier.State.IORef.

src/Control/Carrier/State/IORef.hs

@@ -1,4 +1,12 @@
-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {- | A carrier for the 'State' effect. It uses an 'IORef' internally to handle its state, and thus is safe to use with "Control.Carrier.Resource". Underlying 'IORef' operations are performed with 'readIORef' and 'writeIORef'.
 
@@ -14,8 +22,8 @@ module Control.Carrier.State.IORef
 , module Control.Effect.State
 ) where
 
-import           Control.Applicative       (Alternative (..))
 import           Control.Algebra
+import           Control.Applicative (Alternative(..))
 import           Control.Carrier.Reader
 import           Control.Effect.State
 import           Control.Monad (MonadPlus(..))
@@ -62,11 +70,12 @@ execState s = fmap fst . runState s
 newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a }
   deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
 
-instance (MonadIO m, Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where
+instance (MonadIO m, Algebra sig m) => Algebra (State s :+: sig) (StateC s m) where
-  alg (L act) = do
+  alg hdl sig ctx = case sig of
-    ref <- StateC ask
+    L act -> do
-    case act of
+      ref <- StateC (ask @(IORef s))
-      Put s k -> liftIO (writeIORef ref s) *> k
+      (<$ ctx) <$> case act of
-      Get k   -> liftIO (readIORef ref) >>= k
+        Put s -> liftIO (writeIORef ref s)
-  alg (R other) = StateC (alg (R (handleCoercible other)))
+        Get   -> liftIO (readIORef ref)
+    R other -> StateC (alg (runStateC . hdl) (R other) ctx)
   {-# INLINE alg #-}