{-# language BlockArguments #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language RankNTypes #-}
{-# language TypeOperators #-}
module IO.Effects.IORef
(
runIORefs
, newIORef
, readIORef
, writeIORef
, modifyIORef
, modifyIORef'
, atomicModifyIORef
, atomicModifyIORef'
, IORefs
)
where
import Data.IORef ( IORef )
import qualified Data.IORef
import IO.Effects.Internal
data IORefs m a where
NewIORef :: a -> IORefs ( m :: * -> * ) ( IORef a )
ReadIORef :: IORef a -> IORefs m a
WriteIORef :: IORef a -> a -> IORefs m ()
AtomicModifyIORef :: IORef a -> ( a -> ( a, b ) ) -> IORefs m b
runIORefs :: ProgramWithHandler IORefs es a -> Program es a
runIORefs =
interpret \case
NewIORef a ->
Program ( Data.IORef.newIORef a )
ReadIORef ref ->
Program ( Data.IORef.readIORef ref )
WriteIORef ref a ->
Program ( Data.IORef.writeIORef ref a )
AtomicModifyIORef ref f ->
Program ( Data.IORef.atomicModifyIORef ref f )
newIORef :: Member IORefs es => a -> Program es ( IORef a )
newIORef =
send . NewIORef
readIORef :: Member IORefs es => IORef a -> Program es a
readIORef =
send . ReadIORef
writeIORef :: Member IORefs es => IORef a -> a -> Program es ()
writeIORef ref a =
send ( WriteIORef ref a )
modifyIORef :: Member IORefs es => IORef a -> ( a -> a ) -> Program es ()
modifyIORef ref f =
readIORef ref >>= writeIORef ref . f
modifyIORef' :: Member IORefs es => IORef a -> ( a -> a ) -> Program es ()
modifyIORef' ref f = do
x <-
readIORef ref
let
x' =
f x
x' `seq` writeIORef ref x'
atomicModifyIORef
:: Member IORefs es
=> IORef a -> ( a -> ( a, b ) ) -> Program es b
atomicModifyIORef ref f =
send ( AtomicModifyIORef ref f )
atomicModifyIORef'
:: Member IORefs es
=> IORef a -> ( a -> ( a, b ) ) -> Program es b
atomicModifyIORef' ref f = do
b <-
atomicModifyIORef ref \a ->
case f a of
v@( a',_ ) ->
a' `seq` v
b `seq` return b