mirror of
https://github.com/haskell-effectful/effectful.git
synced 2024-12-18 11:31:38 +03:00
Less unsafe functions, document unsafeness
This commit is contained in:
parent
a9516ac93d
commit
8f37f3f79e
@ -120,7 +120,7 @@ localSeqUnlift
|
|||||||
-- ^ Continuation with the unlifting function in scope.
|
-- ^ Continuation with the unlifting function in scope.
|
||||||
-> Eff es a
|
-> Eff es a
|
||||||
localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
|
localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
|
||||||
unsafeSeqUnliftEff les $ \unlift -> do
|
seqUnliftEff les $ \unlift -> do
|
||||||
(`unEff` es) $ k $ unsafeEff_ . unlift
|
(`unEff` es) $ k $ unsafeEff_ . unlift
|
||||||
|
|
||||||
-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
|
-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
|
||||||
@ -132,7 +132,7 @@ localSeqUnliftIO
|
|||||||
-> ((forall r. Eff localEs r -> IO r) -> IO a)
|
-> ((forall r. Eff localEs r -> IO r) -> IO a)
|
||||||
-- ^ Continuation with the unlifting function in scope.
|
-- ^ Continuation with the unlifting function in scope.
|
||||||
-> Eff es a
|
-> Eff es a
|
||||||
localSeqUnliftIO (LocalEnv les) k = liftIO $ unsafeSeqUnliftEff les k
|
localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
|
||||||
|
|
||||||
-- | Create a local unlifting function with the given strategy.
|
-- | Create a local unlifting function with the given strategy.
|
||||||
localUnlift
|
localUnlift
|
||||||
@ -145,10 +145,10 @@ localUnlift
|
|||||||
-> Eff es a
|
-> Eff es a
|
||||||
localUnlift (LocalEnv les) strategy k = case strategy of
|
localUnlift (LocalEnv les) strategy k = case strategy of
|
||||||
SeqUnlift -> unsafeEff $ \es -> do
|
SeqUnlift -> unsafeEff $ \es -> do
|
||||||
unsafeSeqUnliftEff les $ \unlift -> do
|
seqUnliftEff les $ \unlift -> do
|
||||||
(`unEff` es) $ k $ unsafeEff_ . unlift
|
(`unEff` es) $ k $ unsafeEff_ . unlift
|
||||||
ConcUnlift p l -> unsafeEff $ \es -> do
|
ConcUnlift p l -> unsafeEff $ \es -> do
|
||||||
unsafeConcUnliftEff les p l $ \unlift -> do
|
concUnliftEff les p l $ \unlift -> do
|
||||||
(`unEff` es) $ k $ unsafeEff_ . unlift
|
(`unEff` es) $ k $ unsafeEff_ . unlift
|
||||||
|
|
||||||
-- | Create a local unlifting function with the given strategy.
|
-- | Create a local unlifting function with the given strategy.
|
||||||
@ -161,8 +161,8 @@ localUnliftIO
|
|||||||
-- ^ Continuation with the unlifting function in scope.
|
-- ^ Continuation with the unlifting function in scope.
|
||||||
-> Eff es a
|
-> Eff es a
|
||||||
localUnliftIO (LocalEnv les) strategy k = case strategy of
|
localUnliftIO (LocalEnv les) strategy k = case strategy of
|
||||||
SeqUnlift -> liftIO $ unsafeSeqUnliftEff les k
|
SeqUnlift -> liftIO $ seqUnliftEff les k
|
||||||
ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l k
|
ConcUnlift p l -> liftIO $ concUnliftEff les p l k
|
||||||
|
|
||||||
-- | Utility for lifting 'Eff' operations of type
|
-- | Utility for lifting 'Eff' operations of type
|
||||||
--
|
--
|
||||||
@ -181,7 +181,7 @@ withLiftMap
|
|||||||
-> Eff es r
|
-> Eff es r
|
||||||
withLiftMap k = unsafeEff $ \es -> do
|
withLiftMap k = unsafeEff $ \es -> do
|
||||||
(`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
|
(`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
|
||||||
unsafeSeqUnliftEff localEs $ \unlift -> do
|
seqUnliftEff localEs $ \unlift -> do
|
||||||
(`unEff` es) . mapEff . liftIO $ unlift m
|
(`unEff` es) . mapEff . liftIO $ unlift m
|
||||||
|
|
||||||
-- | Utility for lifting 'IO' operations of type
|
-- | Utility for lifting 'IO' operations of type
|
||||||
@ -215,7 +215,7 @@ withLiftMapIO
|
|||||||
-- ^ Continuation with the lifting function in scope.
|
-- ^ Continuation with the lifting function in scope.
|
||||||
-> Eff es r
|
-> Eff es r
|
||||||
withLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
|
withLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
|
||||||
unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
|
seqUnliftEff es $ \unlift -> mapIO $ unlift m
|
||||||
|
|
||||||
----------------------------------------
|
----------------------------------------
|
||||||
-- Bidirectional lifts
|
-- Bidirectional lifts
|
||||||
@ -237,12 +237,12 @@ localLiftUnlift
|
|||||||
-> Eff es a
|
-> Eff es a
|
||||||
localLiftUnlift (LocalEnv les) strategy k = case strategy of
|
localLiftUnlift (LocalEnv les) strategy k = case strategy of
|
||||||
SeqUnlift -> unsafeEff $ \es -> do
|
SeqUnlift -> unsafeEff $ \es -> do
|
||||||
unsafeSeqUnliftEff es $ \unliftEs -> do
|
seqUnliftEff es $ \unliftEs -> do
|
||||||
unsafeSeqUnliftEff les $ \unliftLocalEs -> do
|
seqUnliftEff les $ \unliftLocalEs -> do
|
||||||
(`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
|
(`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
|
||||||
ConcUnlift p l -> unsafeEff $ \es -> do
|
ConcUnlift p l -> unsafeEff $ \es -> do
|
||||||
unsafeConcUnliftEff es p l $ \unliftEs -> do
|
concUnliftEff es p l $ \unliftEs -> do
|
||||||
unsafeConcUnliftEff les p l $ \unliftLocalEs -> do
|
concUnliftEff les p l $ \unliftLocalEs -> do
|
||||||
(`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
|
(`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
|
||||||
|
|
||||||
-- | Create a local unlifting function with the given strategy along with an
|
-- | Create a local unlifting function with the given strategy along with an
|
||||||
@ -262,8 +262,8 @@ localLiftUnliftIO
|
|||||||
-- ^ Continuation with the lifting and unlifting function in scope.
|
-- ^ Continuation with the lifting and unlifting function in scope.
|
||||||
-> Eff es a
|
-> Eff es a
|
||||||
localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
|
localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
|
||||||
SeqUnlift -> liftIO $ unsafeSeqUnliftEff les $ k unsafeEff_
|
SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_
|
||||||
ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l $ k unsafeEff_
|
ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
|
||||||
|
|
||||||
-- $setup
|
-- $setup
|
||||||
-- >>> import Control.Concurrent
|
-- >>> import Control.Concurrent
|
||||||
|
@ -342,9 +342,9 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
|
|||||||
|
|
||||||
-- | Extend the environment with a new data type (in place).
|
-- | Extend the environment with a new data type (in place).
|
||||||
--
|
--
|
||||||
-- /Note:/ this function is __unsafe__ because it renders the input 'Env'
|
-- This function is __highly unsafe__ because it renders the input 'Env'
|
||||||
-- unusable until the corresponding 'unsafeTailEnv' call, but it's not checked
|
-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not
|
||||||
-- anywhere.
|
-- checked anywhere.
|
||||||
unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))
|
unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))
|
||||||
unsafeConsEnv e f (Env fork gref gen) = case fork of
|
unsafeConsEnv e f (Env fork gref gen) = case fork of
|
||||||
NoFork -> do
|
NoFork -> do
|
||||||
@ -381,11 +381,11 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
|
|||||||
-- | Shrink the environment by one data type (in place). Makes sure the size of
|
-- | Shrink the environment by one data type (in place). Makes sure the size of
|
||||||
-- the environment is as expected.
|
-- the environment is as expected.
|
||||||
--
|
--
|
||||||
-- /Note:/ this function is __unsafe__ because it renders the input 'Env'
|
-- 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.
|
||||||
unsafeTailEnv :: Int -> Env (e : es) -> IO ()
|
unsafeTailEnv :: Int -> Env (e : es) -> IO ()
|
||||||
unsafeTailEnv len (Env fork gref _) = case fork of
|
unsafeTailEnv len (Env fork gref _) = case fork of
|
||||||
NoFork -> shrinkEnvRef len gref
|
NoFork -> shrinkEnvRef len gref
|
||||||
Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
|
Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
|
||||||
where
|
where
|
||||||
shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
|
shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
|
||||||
|
@ -37,8 +37,8 @@ module Effectful.Internal.Monad
|
|||||||
|
|
||||||
--- *** Low-level helpers
|
--- *** Low-level helpers
|
||||||
, unsafeWithLiftMapIO
|
, unsafeWithLiftMapIO
|
||||||
, unsafeSeqUnliftEff
|
, seqUnliftEff
|
||||||
, unsafeConcUnliftEff
|
, concUnliftEff
|
||||||
|
|
||||||
-- * Primitive effects
|
-- * Primitive effects
|
||||||
|
|
||||||
@ -126,10 +126,16 @@ unEff :: Eff es a -> Env es -> IO a
|
|||||||
unEff (Eff m) = m
|
unEff (Eff m) = m
|
||||||
|
|
||||||
-- | Access the underlying 'IO' monad along with the environment.
|
-- | Access the underlying 'IO' monad along with the environment.
|
||||||
|
--
|
||||||
|
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||||
|
-- 'IO' actions into pure 'Eff' operations.
|
||||||
unsafeEff :: (Env es -> IO a) -> Eff es a
|
unsafeEff :: (Env es -> IO a) -> Eff es a
|
||||||
unsafeEff m = Eff (oneShot m)
|
unsafeEff m = Eff (oneShot m)
|
||||||
|
|
||||||
-- | Access the underlying 'IO' monad.
|
-- | Access the underlying 'IO' monad.
|
||||||
|
--
|
||||||
|
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||||
|
-- 'IO' actions into pure 'Eff' operations.
|
||||||
unsafeEff_ :: IO a -> Eff es a
|
unsafeEff_ :: IO a -> Eff es a
|
||||||
unsafeEff_ m = unsafeEff $ \_ -> m
|
unsafeEff_ m = unsafeEff $ \_ -> m
|
||||||
|
|
||||||
@ -141,6 +147,9 @@ unsafeEff_ m = unsafeEff $ \_ -> m
|
|||||||
--
|
--
|
||||||
-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
|
-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
|
||||||
--
|
--
|
||||||
|
-- This function is __unsafe__ because it can be used to introduce arbitrary
|
||||||
|
-- 'IO' actions into pure 'Eff' operations.
|
||||||
|
--
|
||||||
-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
|
-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
|
||||||
-- attempting to do so will result in a runtime error.
|
-- attempting to do so will result in a runtime error.
|
||||||
unsafeWithLiftMapIO
|
unsafeWithLiftMapIO
|
||||||
@ -148,15 +157,15 @@ unsafeWithLiftMapIO
|
|||||||
=> ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
|
=> ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
|
||||||
-> Eff es r
|
-> Eff es r
|
||||||
unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
|
unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
|
||||||
unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
|
seqUnliftEff es $ \unlift -> mapIO $ unlift m
|
||||||
|
|
||||||
-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
|
-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
|
||||||
unsafeSeqUnliftEff
|
seqUnliftEff
|
||||||
:: HasCallStack
|
:: HasCallStack
|
||||||
=> Env es
|
=> Env es
|
||||||
-> ((forall r. Eff es r -> IO r) -> IO a)
|
-> ((forall r. Eff es r -> IO r) -> IO a)
|
||||||
-> IO a
|
-> IO a
|
||||||
unsafeSeqUnliftEff es k = do
|
seqUnliftEff es k = do
|
||||||
tid0 <- myThreadId
|
tid0 <- myThreadId
|
||||||
k $ \m -> do
|
k $ \m -> do
|
||||||
tid <- myThreadId
|
tid <- myThreadId
|
||||||
@ -167,21 +176,21 @@ unsafeSeqUnliftEff es k = do
|
|||||||
++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
|
++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
|
||||||
|
|
||||||
-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
|
-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
|
||||||
unsafeConcUnliftEff
|
concUnliftEff
|
||||||
:: HasCallStack
|
:: HasCallStack
|
||||||
=> Env es
|
=> Env es
|
||||||
-> Persistence
|
-> Persistence
|
||||||
-> Limit
|
-> Limit
|
||||||
-> ((forall r. Eff es r -> IO r) -> IO a)
|
-> ((forall r. Eff es r -> IO r) -> IO a)
|
||||||
-> IO a
|
-> IO a
|
||||||
unsafeConcUnliftEff es Ephemeral (Limited uses) k =
|
concUnliftEff es Ephemeral (Limited uses) k =
|
||||||
unsafeEphemeralConcUnliftIO uses k es unEff
|
ephemeralConcUnliftIO uses k es unEff
|
||||||
unsafeConcUnliftEff es Ephemeral Unlimited k =
|
concUnliftEff es Ephemeral Unlimited k =
|
||||||
unsafeEphemeralConcUnliftIO maxBound k es unEff
|
ephemeralConcUnliftIO maxBound k es unEff
|
||||||
unsafeConcUnliftEff es Persistent (Limited threads) k =
|
concUnliftEff es Persistent (Limited threads) k =
|
||||||
unsafePersistentConcUnliftIO False threads k es unEff
|
persistentConcUnliftIO False threads k es unEff
|
||||||
unsafeConcUnliftEff es Persistent Unlimited k =
|
concUnliftEff es Persistent Unlimited k =
|
||||||
unsafePersistentConcUnliftIO True maxBound k es unEff
|
persistentConcUnliftIO True maxBound k es unEff
|
||||||
|
|
||||||
----------------------------------------
|
----------------------------------------
|
||||||
-- Base
|
-- Base
|
||||||
@ -400,9 +409,9 @@ withEffToIO
|
|||||||
-- ^ Continuation with the unlifting function in scope.
|
-- ^ Continuation with the unlifting function in scope.
|
||||||
-> Eff es a
|
-> Eff es a
|
||||||
withEffToIO f = unliftStrategy >>= \case
|
withEffToIO f = unliftStrategy >>= \case
|
||||||
SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
|
SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
|
||||||
ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
|
ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
|
||||||
unsafeEff $ \es -> unsafeConcUnliftEff es p b f
|
unsafeEff $ \es -> concUnliftEff es p b f
|
||||||
|
|
||||||
----------------------------------------
|
----------------------------------------
|
||||||
-- Helpers
|
-- Helpers
|
||||||
|
@ -6,8 +6,8 @@
|
|||||||
-- This module is intended for internal use only, and may change without warning
|
-- This module is intended for internal use only, and may change without warning
|
||||||
-- in subsequent releases.
|
-- in subsequent releases.
|
||||||
module Effectful.Internal.Unlift
|
module Effectful.Internal.Unlift
|
||||||
( unsafeEphemeralConcUnliftIO
|
( ephemeralConcUnliftIO
|
||||||
, unsafePersistentConcUnliftIO
|
, persistentConcUnliftIO
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
@ -25,14 +25,14 @@ import Effectful.Internal.Utils
|
|||||||
|
|
||||||
-- | Concurrent unlift that doesn't preserve the environment between calls to
|
-- | Concurrent unlift that doesn't preserve the environment between calls to
|
||||||
-- the unlifting function in threads other than its creator.
|
-- the unlifting function in threads other than its creator.
|
||||||
unsafeEphemeralConcUnliftIO
|
ephemeralConcUnliftIO
|
||||||
:: HasCallStack
|
:: HasCallStack
|
||||||
=> Int
|
=> Int
|
||||||
-> ((forall r. m r -> IO r) -> IO a)
|
-> ((forall r. m r -> IO r) -> IO a)
|
||||||
-> Env es
|
-> Env es
|
||||||
-> (forall r. m r -> Env es -> IO r)
|
-> (forall r. m r -> Env es -> IO r)
|
||||||
-> IO a
|
-> IO a
|
||||||
unsafeEphemeralConcUnliftIO uses k es0 unEff = do
|
ephemeralConcUnliftIO uses k es0 unEff = do
|
||||||
unless (uses > 0) $ do
|
unless (uses > 0) $ do
|
||||||
error $ "Invalid number of uses: " ++ show uses
|
error $ "Invalid number of uses: " ++ show uses
|
||||||
tid0 <- myThreadId
|
tid0 <- myThreadId
|
||||||
@ -58,7 +58,7 @@ unsafeEphemeralConcUnliftIO uses k es0 unEff = do
|
|||||||
|
|
||||||
-- | Concurrent unlift that preserves the environment between calls to the
|
-- | Concurrent unlift that preserves the environment between calls to the
|
||||||
-- unlifting function within a particular thread.
|
-- unlifting function within a particular thread.
|
||||||
unsafePersistentConcUnliftIO
|
persistentConcUnliftIO
|
||||||
:: HasCallStack
|
:: HasCallStack
|
||||||
=> Bool
|
=> Bool
|
||||||
-> Int
|
-> Int
|
||||||
@ -66,7 +66,7 @@ unsafePersistentConcUnliftIO
|
|||||||
-> Env es
|
-> Env es
|
||||||
-> (forall r. m r -> Env es -> IO r)
|
-> (forall r. m r -> Env es -> IO r)
|
||||||
-> IO a
|
-> IO a
|
||||||
unsafePersistentConcUnliftIO cleanUp threads k es0 unEff = do
|
persistentConcUnliftIO cleanUp threads k es0 unEff = do
|
||||||
unless (threads > 0) $ do
|
unless (threads > 0) $ do
|
||||||
error $ "Invalid number of threads: " ++ show threads
|
error $ "Invalid number of threads: " ++ show threads
|
||||||
tid0 <- myThreadId
|
tid0 <- myThreadId
|
||||||
|
Loading…
Reference in New Issue
Block a user