mirror of
https://github.com/haskell-effectful/effectful.git
synced 2024-11-27 11:44:45 +03:00
Split Effectful.Dispatch.Static into different modules
This commit is contained in:
parent
eef830f5aa
commit
cc25dc9ef4
@ -82,6 +82,8 @@ library
|
||||
exposed-modules: Effectful
|
||||
Effectful.Dispatch.Dynamic
|
||||
Effectful.Dispatch.Static
|
||||
Effectful.Dispatch.Static.Primitive
|
||||
Effectful.Dispatch.Static.Unsafe
|
||||
Effectful.Error.Dynamic
|
||||
Effectful.Error.Static
|
||||
Effectful.Fail
|
||||
|
@ -356,7 +356,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
|
||||
--
|
||||
-- @'Eff' localEs a -> 'Eff' localEs b@
|
||||
--
|
||||
-- /Note:/ the computation must not run its argument in a separate thread,
|
||||
-- /Note:/ the computation must not run its argument in a different thread,
|
||||
-- attempting to do so will result in a runtime error.
|
||||
withLiftMap
|
||||
:: (HasCallStack, SuffixOf es handlerEs)
|
||||
@ -380,7 +380,7 @@ withLiftMap !_ k = unsafeEff $ \es -> do
|
||||
--
|
||||
-- @'Eff' localEs a -> 'Eff' localEs b@
|
||||
--
|
||||
-- /Note:/ the computation must not run its argument in a separate thread,
|
||||
-- /Note:/ the computation must not run its argument in a different thread,
|
||||
-- attempting to do so will result in a runtime error.
|
||||
--
|
||||
-- Useful e.g. for lifting the unmasking function in
|
||||
|
@ -24,41 +24,18 @@ module Effectful.Dispatch.Static
|
||||
-- ** Unlifts
|
||||
, seqUnliftIO
|
||||
, concUnliftIO
|
||||
, unsafeSeqUnliftIO
|
||||
, unsafeConcUnliftIO
|
||||
|
||||
-- ** Utils
|
||||
, unEff
|
||||
, unsafeEff
|
||||
, unsafeEff_
|
||||
, unsafeLiftMapIO
|
||||
, unsafeUnliftIO
|
||||
|
||||
-- * Primitive API
|
||||
, Env
|
||||
, Relinker(..)
|
||||
, dummyRelinker
|
||||
|
||||
-- ** Representation of effects
|
||||
, EffectRep
|
||||
|
||||
-- ** Operations
|
||||
, emptyEnv
|
||||
, cloneEnv
|
||||
, forkEnv
|
||||
, sizeEnv
|
||||
, checkSizeEnv
|
||||
|
||||
-- ** Extending and shrinking
|
||||
, unsafeConsEnv
|
||||
, unsafeTailEnv
|
||||
|
||||
-- ** Data retrieval and update
|
||||
, getEnv
|
||||
, putEnv
|
||||
, stateEnv
|
||||
, modifyEnv
|
||||
) where
|
||||
|
||||
import Effectful.Internal.Env
|
||||
import GHC.Stack (HasCallStack)
|
||||
|
||||
import Effectful.Internal.Monad
|
||||
|
||||
-- $intro
|
||||
@ -180,27 +157,40 @@ import Effectful.Internal.Monad
|
||||
--
|
||||
-- @'Eff' es a -> 'Eff' es b@
|
||||
--
|
||||
-- This function is __unsafe__ because:
|
||||
-- /Note:/ the computation must not run its argument in a separate thread,
|
||||
-- attempting to do so will result in a runtime error.
|
||||
--
|
||||
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
|
||||
-- computations.
|
||||
--
|
||||
-- - The 'IO' computation must not run its argument in a separate thread, but
|
||||
-- it's not checked anywhere.
|
||||
unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
|
||||
unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
|
||||
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||
-- 'IO' actions into pure 'Eff' computations.
|
||||
unsafeLiftMapIO :: HasCallStack => (IO a -> IO b) -> Eff es a -> Eff es b
|
||||
unsafeLiftMapIO f m = unsafeEff $ \es -> do
|
||||
seqUnliftIO es $ \unlift -> f (unlift m)
|
||||
|
||||
-- | Utility for running 'Eff' computations locally in the 'IO' monad.
|
||||
-- | Create an unlifting function with the 'SeqUnlift' strategy.
|
||||
--
|
||||
-- This function is __unsafe__ because:
|
||||
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||
-- 'IO' actions into pure 'Eff' computations.
|
||||
unsafeSeqUnliftIO
|
||||
:: HasCallStack
|
||||
=> ((forall r. Eff es r -> IO r) -> IO a)
|
||||
-- ^ Continuation with the unlifting function in scope.
|
||||
-> Eff es a
|
||||
unsafeSeqUnliftIO k = unsafeEff $ \es -> do
|
||||
seqUnliftIO es k
|
||||
|
||||
-- | Create an unlifting function with the 'ConcUnlift' strategy.
|
||||
--
|
||||
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
|
||||
-- computations.
|
||||
--
|
||||
-- - Unlifted 'Eff' computations must not be run in a thread distinct from the
|
||||
-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
|
||||
unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
|
||||
unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
|
||||
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||
-- 'IO' actions into pure 'Eff' computations.
|
||||
unsafeConcUnliftIO
|
||||
:: HasCallStack
|
||||
=> Persistence
|
||||
-> Limit
|
||||
-> ((forall r. Eff es r -> IO r) -> IO a)
|
||||
-- ^ Continuation with the unlifting function in scope.
|
||||
-> Eff es a
|
||||
unsafeConcUnliftIO persistence limit k = unsafeEff $ \es -> do
|
||||
concUnliftIO es persistence limit k
|
||||
|
||||
-- $setup
|
||||
-- >>> import Effectful
|
||||
|
36
effectful-core/src/Effectful/Dispatch/Static/Primitive.hs
Normal file
36
effectful-core/src/Effectful/Dispatch/Static/Primitive.hs
Normal file
@ -0,0 +1,36 @@
|
||||
-- | Primitive API for statically dispatched effects.
|
||||
--
|
||||
-- /Warning:/ this module exposes internal implementation details of the 'Eff'
|
||||
-- monad. Most of the time functions from "Effectful.Dispatch.Static" are
|
||||
-- sufficient and safer to use.
|
||||
module Effectful.Dispatch.Static.Primitive
|
||||
( -- * The environment
|
||||
Env
|
||||
|
||||
-- ** Relinker
|
||||
, Relinker(..)
|
||||
, dummyRelinker
|
||||
|
||||
-- ** Representation of effects
|
||||
, EffectRep
|
||||
|
||||
-- ** Extending and shrinking
|
||||
, unsafeConsEnv
|
||||
, unsafeTailEnv
|
||||
|
||||
-- ** Data retrieval and update
|
||||
, getEnv
|
||||
, putEnv
|
||||
, stateEnv
|
||||
, modifyEnv
|
||||
|
||||
-- ** Utils
|
||||
, emptyEnv
|
||||
, cloneEnv
|
||||
, forkEnv
|
||||
, sizeEnv
|
||||
, checkSizeEnv
|
||||
) where
|
||||
|
||||
import Effectful.Internal.Env
|
||||
import Effectful.Internal.Monad
|
40
effectful-core/src/Effectful/Dispatch/Static/Unsafe.hs
Normal file
40
effectful-core/src/Effectful/Dispatch/Static/Unsafe.hs
Normal file
@ -0,0 +1,40 @@
|
||||
module Effectful.Dispatch.Static.Unsafe
|
||||
( reallyUnsafeLiftMapIO
|
||||
, reallyUnsafeUnliftIO
|
||||
) where
|
||||
|
||||
import Effectful.Internal.Monad
|
||||
|
||||
-- | Utility for lifting 'IO' computations of type
|
||||
--
|
||||
-- @'IO' a -> 'IO' b@
|
||||
--
|
||||
-- to
|
||||
--
|
||||
-- @'Eff' es a -> 'Eff' es b@
|
||||
--
|
||||
-- This function is __highly unsafe__ because:
|
||||
--
|
||||
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
|
||||
-- computations.
|
||||
--
|
||||
-- - The 'IO' computation must not run its argument in a different thread, but
|
||||
-- it's not checked anywhere.
|
||||
--
|
||||
-- __If you disregard the second point, segmentation faults await.__
|
||||
reallyUnsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
|
||||
reallyUnsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
|
||||
|
||||
-- | Create an unlifting function.
|
||||
--
|
||||
-- This function is __highly unsafe__ because:
|
||||
--
|
||||
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
|
||||
-- computations.
|
||||
--
|
||||
-- - Unlifted 'Eff' computations must not be run in a thread distinct from the
|
||||
-- caller of 'reallyUnsafeUnliftIO', but it's not checked anywhere.
|
||||
--
|
||||
-- __If you disregard the second point, segmentation faults await.__
|
||||
reallyUnsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
|
||||
reallyUnsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
|
@ -102,6 +102,7 @@ import GHC.Stack
|
||||
|
||||
import Effectful
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
import Effectful.Internal.Utils
|
||||
|
||||
-- | Provide the ability to handle errors of type @e@.
|
||||
|
@ -29,7 +29,7 @@ module Effectful.Internal.Env
|
||||
, checkSizeEnv
|
||||
|
||||
-- ** Extending and shrinking
|
||||
, veryUnsafeConsEnv
|
||||
, reallyUnsafeConsEnv
|
||||
, unsafeTailEnv
|
||||
|
||||
-- ** Data retrieval and update
|
||||
@ -52,12 +52,17 @@ import Effectful.Internal.Utils
|
||||
|
||||
type role Env nominal
|
||||
|
||||
-- | A strict (WHNF), thread local, mutable, extensible record indexed by types
|
||||
-- | A strict (WHNF), __thread local__, mutable, extensible record indexed by types
|
||||
-- of kind 'Effect'.
|
||||
--
|
||||
-- Supports forking, i.e. introduction of local branches for encapsulation of
|
||||
-- data specific to effect handlers.
|
||||
--
|
||||
-- __Warning: the environment is a mutable data structure and cannot be simultaneously used from multiple threads under any circumstances.__
|
||||
--
|
||||
-- In order to pass it to a different thread, you need to perform a deep copy
|
||||
-- with the 'cloneEnv' funtion.
|
||||
--
|
||||
-- Offers very good performance characteristics:
|
||||
--
|
||||
-- - Extending: /O(1)/ (amortized).
|
||||
@ -68,6 +73,7 @@ type role Env nominal
|
||||
--
|
||||
-- - Modification of a specific element: /O(1)/.
|
||||
--
|
||||
--
|
||||
-- Here's an example of how the environment might look:
|
||||
--
|
||||
-- @
|
||||
@ -182,6 +188,8 @@ emptyEnv :: IO (Env '[])
|
||||
emptyEnv = Env NoFork <$> emptyEnvRef <*> newForkIdGen
|
||||
|
||||
-- | Clone the environment.
|
||||
--
|
||||
-- Mostly used to pass the environment to a different thread.
|
||||
cloneEnv :: Env es -> IO (Env es)
|
||||
cloneEnv (Env NoFork gref0 gen0) = do
|
||||
EnvRef n es0 fs0 <- readIORef gref0
|
||||
@ -361,10 +369,12 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
|
||||
-- - The @rep@ type variable is unrestricted, so it's possible to put in a
|
||||
-- different data type than the one retrieved later.
|
||||
--
|
||||
-- - It renders the input 'Env' unusable until the corresponding 'unsafeTailEnv'
|
||||
-- call is made, but it's not checked anywhere.
|
||||
veryUnsafeConsEnv :: rep e -> Relinker rep e -> Env es -> IO (Env (e : es))
|
||||
veryUnsafeConsEnv e f (Env fork gref gen) = case fork of
|
||||
-- - It renders the input 'Env' __unusable__ until the corresponding
|
||||
-- 'unsafeTailEnv' call is made, but it's not checked anywhere.
|
||||
--
|
||||
-- __If you disregard the above, segmentation faults await.__
|
||||
reallyUnsafeConsEnv :: rep e -> Relinker rep e -> Env es -> IO (Env (e : es))
|
||||
reallyUnsafeConsEnv e f (Env fork gref gen) = case fork of
|
||||
NoFork -> do
|
||||
extendEnvRef gref
|
||||
pure $ Env NoFork gref gen
|
||||
@ -394,13 +404,15 @@ veryUnsafeConsEnv e f (Env fork gref gen) = case fork of
|
||||
|
||||
doubleCapacity :: Int -> Int
|
||||
doubleCapacity n = max 1 n * 2
|
||||
{-# NOINLINE veryUnsafeConsEnv #-}
|
||||
{-# NOINLINE reallyUnsafeConsEnv #-}
|
||||
|
||||
-- | Shrink the environment by one data type (in place). Makes sure the size of
|
||||
-- the environment is as expected.
|
||||
--
|
||||
-- This function is __highly unsafe__ because it renders the input 'Env'
|
||||
-- unusable, but it's not checked anywhere.
|
||||
-- __unusable__, but it's not checked anywhere.
|
||||
--
|
||||
-- __If you disregard the above, segmentation faults await.__
|
||||
unsafeTailEnv :: Int -> Env (e : es) -> IO ()
|
||||
unsafeTailEnv len (Env fork gref _) = case fork of
|
||||
NoFork -> shrinkEnvRef len gref
|
||||
|
@ -475,13 +475,15 @@ localStaticRep f m = unsafeEff $ \es -> do
|
||||
-- This function is __highly unsafe__ because it renders the input 'Env'
|
||||
-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not
|
||||
-- checked anywhere.
|
||||
--
|
||||
-- __If you disregard the above, segmentation faults await.__
|
||||
unsafeConsEnv
|
||||
:: EffectRep (DispatchOf e) e
|
||||
-- ^ The representation of the effect.
|
||||
-> Relinker (EffectRep (DispatchOf e)) e
|
||||
-> Env es
|
||||
-> IO (Env (e : es))
|
||||
unsafeConsEnv = veryUnsafeConsEnv
|
||||
unsafeConsEnv = reallyUnsafeConsEnv
|
||||
|
||||
-- | Extract a specific representation of the effect from the environment.
|
||||
getEnv :: e :> es => Env es -> IO (EffectRep (DispatchOf e) e)
|
||||
|
@ -45,6 +45,7 @@ import Control.Concurrent.MVar
|
||||
|
||||
import Effectful
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
|
||||
-- | Provide access to a strict (WHNF), shared, mutable value of type @s@.
|
||||
data State s :: Effect
|
||||
|
@ -31,6 +31,7 @@ import Control.Exception (onException, mask)
|
||||
|
||||
import Effectful
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
|
||||
-- | Provide access to a strict (WHNF), thread local, write only value of type
|
||||
-- @w@.
|
||||
|
@ -32,6 +32,7 @@ import Control.Exception (onException, uninterruptibleMask)
|
||||
|
||||
import Effectful
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
|
||||
-- | Provide access to a strict (WHNF), shared, write only value of type @w@.
|
||||
data Writer w :: Effect
|
||||
|
@ -70,6 +70,8 @@ import qualified GHC.Conc as GHC
|
||||
import Effectful
|
||||
import Effectful.Concurrent.Effect
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
import Effectful.Dispatch.Static.Unsafe
|
||||
|
||||
----------------------------------------
|
||||
-- Basic concurrency operations
|
||||
@ -99,9 +101,7 @@ forkIOWithUnmask
|
||||
:: Concurrent :> es
|
||||
=> ((forall a. Eff es a -> Eff es a) -> Eff es ())
|
||||
-> Eff es C.ThreadId
|
||||
forkIOWithUnmask f = unsafeEff $ \es -> do
|
||||
esF <- cloneEnv es
|
||||
C.forkIOWithUnmask $ \unmask -> unEff (f $ unsafeLiftMapIO unmask) esF
|
||||
forkIOWithUnmask = liftForkWithUnmask C.forkIOWithUnmask
|
||||
|
||||
-- | Lifted 'C.killThread'.
|
||||
killThread :: Concurrent :> es => C.ThreadId -> Eff es ()
|
||||
@ -126,9 +126,7 @@ forkOnWithUnmask
|
||||
=> Int
|
||||
-> ((forall a. Eff es a -> Eff es a) -> Eff es ())
|
||||
-> Eff es C.ThreadId
|
||||
forkOnWithUnmask n f = unsafeEff $ \es -> do
|
||||
esF <- cloneEnv es
|
||||
C.forkOnWithUnmask n $ \unmask -> unEff (f $ unsafeLiftMapIO unmask) esF
|
||||
forkOnWithUnmask n = liftForkWithUnmask (C.forkOnWithUnmask n)
|
||||
|
||||
-- | Lifted 'C.getNumCapabilities'.
|
||||
getNumCapabilities :: Concurrent :> es => Eff es Int
|
||||
@ -192,9 +190,7 @@ forkOSWithUnmask
|
||||
:: Concurrent :> es
|
||||
=> ((forall a. Eff es a -> Eff es a) -> Eff es ())
|
||||
-> Eff es C.ThreadId
|
||||
forkOSWithUnmask f = unsafeEff $ \es -> do
|
||||
esF <- cloneEnv es
|
||||
C.forkOSWithUnmask $ \unmask -> unEff (f $ unsafeLiftMapIO unmask) esF
|
||||
forkOSWithUnmask = liftForkWithUnmask C.forkOSWithUnmask
|
||||
|
||||
-- | Lifted 'C.isCurrentThreadBound'.
|
||||
isCurrentThreadBound :: Concurrent :> es => Eff es Bool
|
||||
@ -218,3 +214,15 @@ runInUnboundThread k = unsafeEff $ \es -> do
|
||||
-- | Lifted 'C.mkWeakThreadId'.
|
||||
mkWeakThreadId :: Concurrent :> es => C.ThreadId -> Eff es (Weak C.ThreadId)
|
||||
mkWeakThreadId = unsafeEff_ . C.mkWeakThreadId
|
||||
|
||||
----------------------------------------
|
||||
-- Helpers
|
||||
|
||||
liftForkWithUnmask
|
||||
:: (((forall c. IO c -> IO c) -> IO a) -> IO C.ThreadId)
|
||||
-> ((forall c. Eff es c -> Eff es c) -> Eff es a)
|
||||
-> Eff es C.ThreadId
|
||||
liftForkWithUnmask fork action = unsafeEff $ \es -> do
|
||||
esF <- cloneEnv es
|
||||
-- Unmask never runs its argument in a different thread.
|
||||
fork $ \unmask -> unEff (action $ reallyUnsafeLiftMapIO unmask) esF
|
||||
|
@ -87,6 +87,8 @@ import qualified UnliftIO.Internals.Async as I
|
||||
import Effectful
|
||||
import Effectful.Concurrent.Effect
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
import Effectful.Dispatch.Static.Unsafe
|
||||
|
||||
-- | Lifted 'A.async'.
|
||||
async :: Concurrent :> es => Eff es a -> Eff es (Async a)
|
||||
@ -524,7 +526,8 @@ liftAsyncWithUnmask
|
||||
-> Eff es (Async a)
|
||||
liftAsyncWithUnmask fork action = unsafeEff $ \es -> do
|
||||
esA <- cloneEnv es
|
||||
fork $ \unmask -> unEff (action $ unsafeLiftMapIO unmask) esA
|
||||
-- Unmask never runs its argument in a different thread.
|
||||
fork $ \unmask -> unEff (action $ reallyUnsafeLiftMapIO unmask) esA
|
||||
|
||||
liftWithAsync
|
||||
:: (IO a -> (Async a -> IO b) -> IO b)
|
||||
@ -543,5 +546,6 @@ liftWithAsyncWithUnmask
|
||||
-> Eff es b
|
||||
liftWithAsyncWithUnmask withA action k = unsafeEff $ \es -> do
|
||||
esA <- cloneEnv es
|
||||
withA (\unmask -> unEff (action $ unsafeLiftMapIO unmask) esA)
|
||||
-- Unmask never runs its argument in a different thread.
|
||||
withA (\unmask -> unEff (action $ reallyUnsafeLiftMapIO unmask) esA)
|
||||
(\a -> unEff (k a) es)
|
||||
|
@ -34,6 +34,8 @@ import qualified Control.Concurrent.MVar as M
|
||||
import Effectful
|
||||
import Effectful.Concurrent.Effect
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
import Effectful.Dispatch.Static.Unsafe
|
||||
|
||||
-- | Lifted 'M.newEmptyMVar'.
|
||||
newEmptyMVar :: Concurrent :> es => Eff es (MVar a)
|
||||
@ -77,35 +79,36 @@ tryReadMVar = unsafeEff_ . M.tryReadMVar
|
||||
|
||||
-- | Lifted 'M.withMVar'.
|
||||
withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
|
||||
withMVar var f = unsafeUnliftIO $ \unlift -> do
|
||||
withMVar var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.withMVar var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.withMVarMasked'.
|
||||
withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
|
||||
withMVarMasked var f = unsafeUnliftIO $ \unlift -> do
|
||||
withMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.withMVarMasked var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.modifyMVar_'.
|
||||
modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
|
||||
modifyMVar_ var f = unsafeUnliftIO $ \unlift -> do
|
||||
modifyMVar_ var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.modifyMVar_ var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.modifyMVar'.
|
||||
modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
|
||||
modifyMVar var f = unsafeUnliftIO $ \unlift -> do
|
||||
modifyMVar var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.modifyMVar var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.modifyMVarMasked_'.
|
||||
modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
|
||||
modifyMVarMasked_ var f = unsafeUnliftIO $ \unlift -> do
|
||||
modifyMVarMasked_ var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.modifyMVarMasked_ var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.modifyMVarMasked'.
|
||||
modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
|
||||
modifyMVarMasked var f = unsafeUnliftIO $ \unlift -> do
|
||||
modifyMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do
|
||||
M.modifyMVarMasked var $ unlift . f
|
||||
|
||||
-- | Lifted 'M.mkWeakMVar'.
|
||||
mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
|
||||
mkWeakMVar var f = unsafeUnliftIO $ \unlift -> do
|
||||
M.mkWeakMVar var $ unlift f
|
||||
mkWeakMVar var f = unsafeEff $ \es -> do
|
||||
-- The finalizer can run at any point and in any thread.
|
||||
M.mkWeakMVar var . unEff f =<< cloneEnv es
|
||||
|
@ -97,53 +97,56 @@ import GHC.Natural (Natural)
|
||||
import Effectful
|
||||
import Effectful.Concurrent.Effect
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
|
||||
-- | Lifted version of 'STM.atomically'
|
||||
-- | Lifted version of 'STM.atomically'.
|
||||
atomically :: Concurrent :> es => STM a -> Eff es a
|
||||
atomically = unsafeEff_ . STM.atomically
|
||||
|
||||
-- | Lifted version of 'STM.newTVarIO'
|
||||
-- | Lifted version of 'STM.newTVarIO'.
|
||||
newTVarIO :: Concurrent :> es => a -> Eff es (TVar a)
|
||||
newTVarIO = unsafeEff_ . STM.newTVarIO
|
||||
|
||||
-- | Lifted version of 'STM.readTVarIO'
|
||||
-- | Lifted version of 'STM.readTVarIO'.
|
||||
readTVarIO :: Concurrent :> es => TVar a -> Eff es a
|
||||
readTVarIO = unsafeEff_ . STM.readTVarIO
|
||||
|
||||
-- | Lifted version of 'STM.registerDelay'
|
||||
-- | Lifted version of 'STM.registerDelay'.
|
||||
registerDelay :: Concurrent :> es => Int -> Eff es (TVar Bool)
|
||||
registerDelay = unsafeEff_ . STM.registerDelay
|
||||
|
||||
-- | Lifted version of 'STM.mkWeakTVar'
|
||||
-- | Lifted version of 'STM.mkWeakTVar'.
|
||||
mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
|
||||
mkWeakTVar var final = unsafeUnliftIO $ \unlift -> do
|
||||
STM.mkWeakTVar var $ unlift final
|
||||
mkWeakTVar var f = unsafeEff $ \es -> do
|
||||
-- The finalizer can run at any point and in any thread.
|
||||
STM.mkWeakTVar var . unEff f =<< cloneEnv es
|
||||
|
||||
-- | Lifted version of 'STM.newTMVarIO'
|
||||
-- | Lifted version of 'STM.newTMVarIO'.
|
||||
newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
|
||||
newTMVarIO = unsafeEff_ . STM.newTMVarIO
|
||||
|
||||
-- | Lifted version of 'STM.newEmptyTMVarIO'
|
||||
-- | Lifted version of 'STM.newEmptyTMVarIO'.
|
||||
newEmptyTMVarIO :: Concurrent :> es => Eff es (TMVar a)
|
||||
newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO
|
||||
|
||||
-- | Lifted version of 'STM.mkWeakTMVar'
|
||||
-- | Lifted version of 'STM.mkWeakTMVar'.
|
||||
mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
|
||||
mkWeakTMVar var final = unsafeUnliftIO $ \unlift -> do
|
||||
STM.mkWeakTMVar var $ unlift final
|
||||
mkWeakTMVar var f = unsafeEff $ \es -> do
|
||||
-- The finalizer can run at any point and in any thread.
|
||||
STM.mkWeakTMVar var . unEff f =<< cloneEnv es
|
||||
|
||||
-- | Lifted version of 'STM.newTChanIO'
|
||||
-- | Lifted version of 'STM.newTChanIO'.
|
||||
newTChanIO :: Concurrent :> es => Eff es (TChan a)
|
||||
newTChanIO = unsafeEff_ STM.newTChanIO
|
||||
|
||||
-- | Lifted version of 'STM.newBroadcastTChanIO'
|
||||
-- | Lifted version of 'STM.newBroadcastTChanIO'.
|
||||
newBroadcastTChanIO :: Concurrent :> es => Eff es (TChan a)
|
||||
newBroadcastTChanIO = unsafeEff_ STM.newBroadcastTChanIO
|
||||
|
||||
-- | Lifted version of 'STM.newTQueueIO'
|
||||
-- | Lifted version of 'STM.newTQueueIO'.
|
||||
newTQueueIO :: Concurrent :> es => Eff es (TQueue a)
|
||||
newTQueueIO = unsafeEff_ STM.newTQueueIO
|
||||
|
||||
-- | Lifted version of 'STM.newTBQueueIO'
|
||||
-- | Lifted version of 'STM.newTBQueueIO'.
|
||||
newTBQueueIO :: Concurrent :> es => Natural -> Eff es (TBQueue a)
|
||||
newTBQueueIO = unsafeEff_ . STM.newTBQueueIO
|
||||
|
@ -272,7 +272,7 @@ findFileWith
|
||||
-> [FilePath]
|
||||
-> String
|
||||
-> Eff es (Maybe FilePath)
|
||||
findFileWith p dirs n = unsafeUnliftIO $ \unlift -> do
|
||||
findFileWith p dirs n = unsafeSeqUnliftIO $ \unlift -> do
|
||||
D.findFileWith (unlift . p) dirs n
|
||||
|
||||
-- | Lifted 'D.findFilesWith'.
|
||||
@ -282,7 +282,7 @@ findFilesWith
|
||||
-> [FilePath]
|
||||
-> String
|
||||
-> Eff es [FilePath]
|
||||
findFilesWith p dirs ns = unsafeUnliftIO $ \unlift -> do
|
||||
findFilesWith p dirs ns = unsafeSeqUnliftIO $ \unlift -> do
|
||||
D.findFilesWith (unlift . p) dirs ns
|
||||
|
||||
----------------------------------------
|
||||
|
@ -52,7 +52,7 @@ withFile
|
||||
-> IOMode
|
||||
-> (Handle -> Eff es a)
|
||||
-> Eff es a
|
||||
withFile fp mode inner = unsafeUnliftIO $ \unlift -> do
|
||||
withFile fp mode inner = unsafeSeqUnliftIO $ \unlift -> do
|
||||
IO.withFile fp mode $ unlift . inner
|
||||
|
||||
-- | Lifted version of 'IO.withBinaryFile'.
|
||||
@ -62,7 +62,7 @@ withBinaryFile
|
||||
-> IOMode
|
||||
-> (Handle -> Eff es a)
|
||||
-> Eff es a
|
||||
withBinaryFile fp mode inner = unsafeUnliftIO $ \unlift -> do
|
||||
withBinaryFile fp mode inner = unsafeSeqUnliftIO $ \unlift -> do
|
||||
IO.withBinaryFile fp mode $ unlift . inner
|
||||
|
||||
-- | Lifted version of 'IO.openFile'
|
||||
|
@ -133,7 +133,7 @@ withCreateProcess
|
||||
=> P.CreateProcess
|
||||
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
|
||||
-> Eff es a
|
||||
withCreateProcess cp cb = unsafeUnliftIO $ \unlift -> do
|
||||
withCreateProcess cp cb = unsafeSeqUnliftIO $ \unlift -> do
|
||||
P.withCreateProcess cp $ \inh outh errh ph -> unlift $ cb inh outh errh ph
|
||||
|
||||
-- | Lifted 'P.cleanupProcess'.
|
||||
|
@ -29,6 +29,7 @@ import qualified Control.Monad.Trans.Resource.Internal as RI
|
||||
|
||||
import Effectful
|
||||
import Effectful.Dispatch.Static
|
||||
import Effectful.Dispatch.Static.Primitive
|
||||
|
||||
-- | Data tag for a resource effect.
|
||||
data Resource :: Effect
|
||||
|
@ -36,7 +36,7 @@ withSystemTempFile
|
||||
-> (FilePath -> Handle -> Eff es a)
|
||||
-- ^ Callback that can use the file.
|
||||
-> Eff es a
|
||||
withSystemTempFile template action = unsafeUnliftIO $ \unlift -> do
|
||||
withSystemTempFile template action = unsafeSeqUnliftIO $ \unlift -> do
|
||||
T.withSystemTempFile template $ \fp handle -> unlift $ action fp handle
|
||||
|
||||
-- | Lifted 'T.withSystemTempDirectory'.
|
||||
@ -47,7 +47,7 @@ withSystemTempDirectory
|
||||
-> (FilePath -> Eff es a)
|
||||
-- ^ Callback that can use the directory.
|
||||
-> Eff es a
|
||||
withSystemTempDirectory template action = unsafeUnliftIO $ \unlift -> do
|
||||
withSystemTempDirectory template action = unsafeSeqUnliftIO $ \unlift -> do
|
||||
T.withSystemTempDirectory template $ \fp -> unlift $ action fp
|
||||
|
||||
-- | Lifted 'T.withTempFile'.
|
||||
@ -60,7 +60,7 @@ withTempFile
|
||||
-> (FilePath -> Handle -> Eff es a)
|
||||
-- ^ Callback that can use the file.
|
||||
-> Eff es a
|
||||
withTempFile tmpDir template action = unsafeUnliftIO $ \unlift -> do
|
||||
withTempFile tmpDir template action = unsafeSeqUnliftIO $ \unlift -> do
|
||||
T.withTempFile tmpDir template $ \fp handle -> unlift $ action fp handle
|
||||
|
||||
-- | Lifted 'T.withTempDirectory'.
|
||||
@ -73,5 +73,5 @@ withTempDirectory
|
||||
-> (FilePath -> Eff es a)
|
||||
-- ^ Callback that can use the directory.
|
||||
-> Eff es a
|
||||
withTempDirectory tmpDir template action = unsafeUnliftIO $ \unlift -> do
|
||||
withTempDirectory tmpDir template action = unsafeSeqUnliftIO $ \unlift -> do
|
||||
T.withTempDirectory tmpDir template $ \fp -> unlift $ action fp
|
||||
|
Loading…
Reference in New Issue
Block a user