Less unsafe functions, document unsafeness

This commit is contained in:
Andrzej Rybczak 2021-07-31 17:03:56 +02:00
parent a9516ac93d
commit 8f37f3f79e
4 changed files with 50 additions and 41 deletions

View File

@ -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

View File

@ -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 ()

View File

@ -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

View File

@ -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