Update Control.Carrier.State.IORef.

main
Rob Rix 2020-07-03 13:42:20 -04:00
parent 4d63df6eb3
commit f478f9bffb
No known key found for this signature in database
GPG Key ID: 2BE643E01DC032AE
1 changed files with 20 additions and 11 deletions

View File

@ -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'. {- | 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,11 +22,11 @@ module Control.Carrier.State.IORef
, module Control.Effect.State , module Control.Effect.State
) where ) where
import Control.Applicative (Alternative (..))
import Control.Algebra import Control.Algebra
import Control.Applicative (Alternative(..))
import Control.Carrier.Reader import Control.Carrier.Reader
import Control.Effect.State import Control.Effect.State
import Control.Monad (MonadPlus (..)) import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix import Control.Monad.Fix
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -62,11 +70,12 @@ execState s = fmap fst . runState s
newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a } newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a }
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus) 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 #-} {-# INLINE alg #-}