@@ -17,13 +17,9 @@ module Effectful.Internal.Unlift
17 , concUnlift
17 , concUnlift
18 , ephemeralConcUnlift
18 , ephemeralConcUnlift
19 , persistentConcUnlift
19 , persistentConcUnlift
21− -- * Unlifting errors
25import Control.Concurrent
22import Control.Concurrent
26−import Control.Exception
27import Control.Monad
23import Control.Monad
28import GHC.Conc.Sync (ThreadId(..))
24import GHC.Conc.Sync (ThreadId(..))
29import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
25import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -96,10 +92,6 @@ data Limit
96-- Unlift functions
92-- Unlift functions
98-- | Sequential unlift.
94-- | Sequential unlift.
100−-- Exceptions thrown by this function:
102−-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
104 :: HasCallStack
96 :: HasCallStack
105 => ((forall r. m r -> IO r) -> IO a)
97 => ((forall r. m r -> IO r) -> IO a)
@@ -112,7 +104,9 @@ seqUnlift k es unEff = do
112 tid <- myThreadId
104 tid <- myThreadId
113 if tid `eqThreadId` tid0
105 if tid `eqThreadId` tid0
114 then unEff m es
106 then unEff m es
115− else throwIO InvalidUseOfSeqUnlift
107+ else error
108+ $ "If you want to use the unlifting function to run Eff operations "
109+ ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
117-- | Concurrent unlift for various strategies and limits.
111-- | Concurrent unlift for various strategies and limits.
118concUnlift
112concUnlift
@@ -134,11 +128,6 @@ concUnlift Persistent Unlimited k =
135-- | Concurrent unlift that doesn't preserve the environment between calls to
129-- | Concurrent unlift that doesn't preserve the environment between calls to
136-- the unlifting function in threads other than its creator.
130-- the unlifting function in threads other than its creator.
138−-- Exceptions thrown by this function:
140−-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
141−-- - 'ExceededNumberOfUses' if the unlift function is called too often.
142ephemeralConcUnlift
131ephemeralConcUnlift
143 :: HasCallStack
132 :: HasCallStack
@@ -149,7 +138,7 @@ ephemeralConcUnlift
150ephemeralConcUnlift uses k es0 unEff = do
139ephemeralConcUnlift uses k es0 unEff = do
151 unless (uses > 0) $ do
140 unless (uses > 0) $ do
152− throwIO $ InvalidNumberOfUses uses
141+ error $ "Invalid number of uses: " ++ show uses
153 tid0 <- myThreadId
142 tid0 <- myThreadId
154 -- Create a copy of the environment as a template for the other threads to
143 -- Create a copy of the environment as a template for the other threads to
155 -- use. This can't be done from inside the callback as the environment might
144 -- use. This can't be done from inside the callback as the environment might
@@ -160,7 +149,10 @@ ephemeralConcUnlift uses k es0 unEff = do
160 es <- myThreadId >>= \case
149 es <- myThreadId >>= \case
161 tid | tid0 `eqThreadId` tid -> pure es0
150 tid | tid0 `eqThreadId` tid -> pure es0
162 _ -> modifyMVar mvUses $ \case
151 _ -> modifyMVar mvUses $ \case
163− 0 -> throwIO $ ExceededNumberOfUses uses
152+ 0 -> error
153+ $ "Number of permitted calls (" ++ show uses ++ ") to the unlifting "
154+ ++ "function in other threads was exceeded. Please increase the limit "
155+ ++ "or use the unlimited variant."
164 1 -> pure (0, esTemplate)
156 1 -> pure (0, esTemplate)
166 let newUses = n - 1
158 let newUses = n - 1
@@ -170,12 +162,6 @@ ephemeralConcUnlift uses k es0 unEff = do
171-- | Concurrent unlift that preserves the environment between calls to the
163-- | Concurrent unlift that preserves the environment between calls to the
172-- unlifting function within a particular thread.
164-- unlifting function within a particular thread.
174−-- Exceptions thrown by this function:
176−-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
177−-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
179persistentConcUnlift
165persistentConcUnlift
180 :: HasCallStack
166 :: HasCallStack
@@ -187,7 +173,7 @@ persistentConcUnlift
188persistentConcUnlift cleanUp threads k es0 unEff = do
174persistentConcUnlift cleanUp threads k es0 unEff = do
189 unless (threads > 0) $ do
175 unless (threads > 0) $ do
190− throwIO $ InvalidNumberOfThreads threads
176+ error $ "Invalid number of threads: " ++ show threads
191 tid0 <- myThreadId
177 tid0 <- myThreadId
192 -- Create a copy of the environment as a template for the other threads to
178 -- Create a copy of the environment as a template for the other threads to
193 -- use. This can't be done from inside the callback as the environment might
179 -- use. This can't be done from inside the callback as the environment might
@@ -205,7 +191,10 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
205 case mes of
191 case mes of
206 Just es -> pure (te, es)
192 Just es -> pure (te, es)
207 Nothing -> case teCapacity te of
193 Nothing -> case teCapacity te of
208− 0 -> throwIO $ ExceededNumberOfThreads threads
194+ 0 -> error
195+ $ "Number of other threads (" ++ show threads ++ ") permitted to "
196+ ++ "use the unlifting function was exceeded. Please increase the "
197+ ++ "limit or use the unlimited variant."
210 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
199 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
211 let newEntries = ThreadEntries
200 let newEntries = ThreadEntries
@@ -223,38 +212,6 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
223 newEntries `seq` pure (newEntries, es)
212 newEntries `seq` pure (newEntries, es)
224 unEff m es
213 unEff m es
226−----------------------------------------
229−-- | An type used for errors occuring in unlifting functions.
231−-- Use the 'displayException' method of the 'Exception' type class to get
232−-- descriptive error messages.
234− = InvalidNumberOfThreads !Int
235− | InvalidNumberOfUses !Int
236− | InvalidUseOfSeqUnlift
237− | ExceededNumberOfThreads !Int
238− | ExceededNumberOfUses !Int
239− deriving (Eq, Generic, Show)
241−instance Exception UnliftError where
242− displayException (InvalidNumberOfThreads threads) =
243− "Invalid number of threads: " ++ show threads
244− displayException (InvalidNumberOfUses uses) =
245− "Invalid number of uses: " ++ show uses
246− displayException (ExceededNumberOfThreads threads) =
247− "Number of other threads (" ++ show threads ++ ") permitted to use the " ++
248− "unlifting function was exceeded. Please increase the limit or use the " ++
249− "unlimited variant."
250− displayException (ExceededNumberOfUses uses) =
251− "Number of permitted calls (" ++ show uses ++ ") to the unlifting " ++
252− "function in other threads was exceeded. Please increase the limit or " ++
253− "use the unlimited variant."
254− displayException InvalidUseOfSeqUnlift =
255− "If you want to use the unlifting function to run Eff operations in " ++
256− "multiple threads, have a look at UnliftStrategy (ConcUnlift)."
258----------------------------------------
215----------------------------------------
259-- Data types
216-- Data types