Ref effect, bridged to State

Ref.hs

data Ref ref (m :: K.Type -> K.Type) k where
  NewRef :: a -> Ref ref m (ref a)
  ReadRef :: ref a -> Ref ref m a
  WriteRef :: ref a -> a -> Ref ref m ()

newRef :: Has (Ref ref) sig m => a -> m (ref a)
newRef a = send (NewRef a)

readRef :: Has (Ref ref) sig m => ref a -> m a
readRef ref = send (ReadRef ref)

writeRef :: Has (Ref ref) sig m => ref a -> a -> m ()
writeRef ref a = send (WriteRef ref a)


newtype RefIOC m a = RefIOC { runRefIOC :: m a }
  deriving (Applicative, Functor, Monad)

instance (Algebra sig m, MonadIO m) => Algebra (Ref IORef :+: sig) (RefIOC m) where
  alg hdl sig ctx = RefIOC $ case sig of
    A.L (NewRef a)       -> (<$ ctx) <$> liftIO (newIORef a)
    A.L (ReadRef ref)    -> (<$ ctx) <$> liftIO (readIORef ref)
    A.L (WriteRef ref a) -> ctx <$ liftIO (writeIORef ref a)
    A.R other            -> alg (runRefIOC . hdl) other ctx


newtype RefSTC s a = RefSTC { runRefSTC :: ST s a }
  deriving (Applicative, Functor, Monad)

instance Algebra (Ref (STRef s)) (RefSTC s) where
  alg _ sig ctx = RefSTC $ case sig of
    NewRef a       -> (<$ ctx) <$> newSTRef a
    ReadRef ref    -> (<$ ctx) <$> readSTRef ref
    WriteRef ref a -> ctx <$ writeSTRef ref a


newtype StateFromRefC ref s m a = StateFromRefC { runStateFromRefC :: ref s -> m a }
  deriving (Functor)
  deriving (Applicative, Monad) via ReaderC (ref s) m

instance Has (Ref ref) sig m => Algebra (State s :+: sig) (StateFromRefC ref s m) where
  alg hdl sig ctx = StateFromRefC $ \ ref -> case sig of
    A.L Get     -> (<$ ctx) <$> readRef ref
    A.L (Put s) -> ctx <$ writeRef ref s
    A.R other   -> alg ((`runStateFromRefC` ref) . hdl) other ctx

-- NB: We can't bridge in the other direction (make a Ref effect from an enclosing State effect) because there's only one possible reference, so making new ones neither typechecks nor makes any sense. We can do it by removing the @newRef@ operation from the effect, but then acquiring new references for the @IO@ or @ST@ monads becomes onerous. Splitting into two effects doesn't seem worthwhile since the one only including @newRef@ would only be absent for the one case.