Rename and move around a few functions

This commit is contained in:
Andrzej Rybczak 2021-12-06 21:11:29 +01:00
parent f685d6530e
commit a01f6e307e
4 changed files with 95 additions and 95 deletions

View File

@ -77,7 +77,7 @@ localSeqUnlift
-- ^ Continuation with the unlifting function in scope.
-> Eff es a
localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
seqUnliftEff les $ \unlift -> do
seqUnliftIO les $ \unlift -> do
(`unEff` es) $ k $ unsafeEff_ . unlift
-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
@ -89,7 +89,7 @@ localSeqUnliftIO
-> ((forall r. Eff localEs r -> IO r) -> IO a)
-- ^ Continuation with the unlifting function in scope.
-> Eff es a
localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k
-- | Create a local unlifting function with the given strategy.
localUnlift
@ -102,10 +102,10 @@ localUnlift
-> Eff es a
localUnlift (LocalEnv les) strategy k = case strategy of
SeqUnlift -> unsafeEff $ \es -> do
seqUnliftEff les $ \unlift -> do
seqUnliftIO les $ \unlift -> do
(`unEff` es) $ k $ unsafeEff_ . unlift
ConcUnlift p l -> unsafeEff $ \es -> do
concUnliftEff les p l $ \unlift -> do
concUnliftIO les p l $ \unlift -> do
(`unEff` es) $ k $ unsafeEff_ . unlift
-- | Create a local unlifting function with the given strategy.
@ -118,8 +118,8 @@ localUnliftIO
-- ^ Continuation with the unlifting function in scope.
-> Eff es a
localUnliftIO (LocalEnv les) strategy k = case strategy of
SeqUnlift -> liftIO $ seqUnliftEff les k
ConcUnlift p l -> liftIO $ concUnliftEff les p l k
SeqUnlift -> liftIO $ seqUnliftIO les k
ConcUnlift p l -> liftIO $ concUnliftIO les p l k
-- | Utility for lifting 'Eff' operations of type
--
@ -142,7 +142,7 @@ withLiftMap !_ k = unsafeEff $ \es -> do
-- The LocalEnv parameter is not used, but we need it to constraint the
-- localEs type variable. It's also strict so that callers don't cheat.
(`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
seqUnliftEff localEs $ \unlift -> do
seqUnliftIO localEs $ \unlift -> do
(`unEff` es) . mapEff . unsafeEff_ $ unlift m
-- | Utility for lifting 'IO' operations of type
@ -180,7 +180,7 @@ withLiftMapIO
withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
-- The LocalEnv parameter is not used, but we need it to constraint the
-- localEs type variable. It's also strict so that callers don't cheat.
seqUnliftEff es $ \unlift -> mapIO $ unlift m
seqUnliftIO es $ \unlift -> mapIO $ unlift m
----------------------------------------
-- Bidirectional lifts
@ -202,12 +202,12 @@ localLiftUnlift
-> Eff es a
localLiftUnlift (LocalEnv les) strategy k = case strategy of
SeqUnlift -> unsafeEff $ \es -> do
seqUnliftEff es $ \unliftEs -> do
seqUnliftEff les $ \unliftLocalEs -> do
seqUnliftIO es $ \unliftEs -> do
seqUnliftIO les $ \unliftLocalEs -> do
(`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
ConcUnlift p l -> unsafeEff $ \es -> do
concUnliftEff es p l $ \unliftEs -> do
concUnliftEff les p l $ \unliftLocalEs -> do
concUnliftIO es p l $ \unliftEs -> do
concUnliftIO les p l $ \unliftLocalEs -> do
(`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
-- | Create a local unlifting function with the given strategy along with an
@ -227,8 +227,8 @@ localLiftUnliftIO
-- ^ Continuation with the lifting and unlifting function in scope.
-> Eff es a
localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_
ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
-- $setup
-- >>> import Control.Concurrent

View File

@ -46,6 +46,41 @@ module Effectful.Dispatch.Static
, unEff
) where
import GHC.Stack (HasCallStack)
import Effectful.Internal.Effect
import Effectful.Internal.Env
import Effectful.Internal.Monad
-- | Utility for lifting 'IO' operations of type
--
-- @'IO' a -> 'IO' b@
--
-- to
--
-- @'Eff' es a -> 'Eff' es b@
--
-- This function is __unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
-- operations.
--
-- - The 'IO' operation 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)
-- | Utility for running 'Eff' computations locally in the 'IO' monad.
--
-- This function is __unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
-- operations.
--
-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
unsafeUnliftIO
:: HasCallStack
=> ((forall r. Eff es r -> IO r) -> IO a)
-> Eff es a
unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)

View File

@ -36,10 +36,8 @@ module Effectful.Internal.Monad
, UnliftError(..)
--- *** Low-level helpers
, unsafeLiftMapIO
, unsafeUnliftIO
, seqUnliftEff
, concUnliftEff
, seqUnliftIO
, concUnliftIO
-- * Effects
@ -148,41 +146,8 @@ unsafeEff m = Eff (oneShot m)
unsafeEff_ :: IO a -> Eff es a
unsafeEff_ m = unsafeEff $ \_ -> m
-- | Utility for lifting 'IO' operations of type
--
-- @'IO' a -> 'IO' b@
--
-- to
--
-- @'Eff' es a -> 'Eff' es b@
--
-- This function is __unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
-- operations.
--
-- - The 'IO' operation 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)
-- | Utility for running 'Eff' computations locally in the 'IO' monad.
--
-- This function is __unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
-- operations.
--
-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
unsafeUnliftIO
:: HasCallStack
=> ((forall r. Eff es r -> IO r) -> IO a)
-> Eff es a
unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
----------------------------------------
-- Unlifting Eff
-- Unlifting IO
-- | Get the current 'UnliftStrategy'.
unliftStrategy :: IOE :> es => Eff es UnliftStrategy
@ -194,28 +159,6 @@ unliftStrategy = do
withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
--
-- Exceptions thrown by this function:
--
-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
seqUnliftEff
:: HasCallStack
=> Env es
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
seqUnliftEff es k = seqUnliftIO k es unEff
-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
concUnliftEff
:: HasCallStack
=> Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff
-- | Create an unlifting function with the current 'UnliftStrategy'.
--
-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
@ -229,9 +172,31 @@ withEffToIO
-- ^ Continuation with the unlifting function in scope.
-> Eff es a
withEffToIO f = unliftStrategy >>= \case
SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f
ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
unsafeEff $ \es -> concUnliftEff es p b f
unsafeEff $ \es -> concUnliftIO es p b f
-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
--
-- Exceptions thrown by this function:
--
-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
seqUnliftIO
:: HasCallStack
=> Env es
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
seqUnliftIO es k = seqUnlift k es unEff
-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
concUnliftIO
:: HasCallStack
=> Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
----------------------------------------
-- Base

View File

@ -13,10 +13,10 @@ module Effectful.Internal.Unlift
, Limit(..)
-- * Unlifting functions
, seqUnliftIO
, concUnliftIO
, ephemeralConcUnliftIO
, persistentConcUnliftIO
, seqUnlift
, concUnlift
, ephemeralConcUnlift
, persistentConcUnlift
-- * Unlifting errors
, UnliftError(..)
@ -100,13 +100,13 @@ data Limit
-- Exceptions thrown by this function:
--
-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
seqUnliftIO
seqUnlift
:: HasCallStack
=> ((forall r. m r -> IO r) -> IO a)
-> Env es
-> (forall r. m r -> Env es -> IO r)
-> IO a
seqUnliftIO k es unEff = do
seqUnlift k es unEff = do
tid0 <- myThreadId
k $ \m -> do
tid <- myThreadId
@ -115,7 +115,7 @@ seqUnliftIO k es unEff = do
else throwIO InvalidUseOfSeqUnlift
-- | Concurrent unlift for various strategies and limits.
concUnliftIO
concUnlift
:: HasCallStack
=> Persistence
-> Limit
@ -123,14 +123,14 @@ concUnliftIO
-> Env es
-> (forall r. m r -> Env es -> IO r)
-> IO a
concUnliftIO Ephemeral (Limited uses) k =
ephemeralConcUnliftIO uses k
concUnliftIO Ephemeral Unlimited k =
ephemeralConcUnliftIO maxBound k
concUnliftIO Persistent (Limited threads) k =
persistentConcUnliftIO False threads k
concUnliftIO Persistent Unlimited k =
persistentConcUnliftIO True maxBound k
concUnlift Ephemeral (Limited uses) k =
ephemeralConcUnlift uses k
concUnlift Ephemeral Unlimited k =
ephemeralConcUnlift maxBound k
concUnlift Persistent (Limited threads) k =
persistentConcUnlift False threads k
concUnlift Persistent Unlimited k =
persistentConcUnlift True maxBound k
-- | Concurrent unlift that doesn't preserve the environment between calls to
-- the unlifting function in threads other than its creator.
@ -139,7 +139,7 @@ concUnliftIO Persistent Unlimited k =
--
-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
-- - 'ExceededNumberOfUses' if the unlift function is called too often.
ephemeralConcUnliftIO
ephemeralConcUnlift
:: HasCallStack
=> Int
-- ^ Number of permitted uses of the unlift function.
@ -147,7 +147,7 @@ ephemeralConcUnliftIO
-> Env es
-> (forall r. m r -> Env es -> IO r)
-> IO a
ephemeralConcUnliftIO uses k es0 unEff = do
ephemeralConcUnlift uses k es0 unEff = do
unless (uses > 0) $ do
throwIO $ InvalidNumberOfUses uses
tid0 <- myThreadId
@ -176,7 +176,7 @@ ephemeralConcUnliftIO uses k es0 unEff = do
-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
-- threads.
persistentConcUnliftIO
persistentConcUnlift
:: HasCallStack
=> Bool
-> Int
@ -185,7 +185,7 @@ persistentConcUnliftIO
-> Env es
-> (forall r. m r -> Env es -> IO r)
-> IO a
persistentConcUnliftIO cleanUp threads k es0 unEff = do
persistentConcUnlift cleanUp threads k es0 unEff = do
unless (threads > 0) $ do
throwIO $ InvalidNumberOfThreads threads
tid0 <- myThreadId