git.iko.soy/effectful
on master help sign in
Revert to using error calls in unlift functions for stack traces

1) These exceptions are not supposed to be handled, just serve as an indication during development that an insufficient strategy was used. 2) *Unlift functions are sprinked with HasCallStack constraints so that on error you can see which unlifting function needs to be adjusted. Sadly, throwing a normal exception (unlike using error) doesn't give the stack trace.

commitf4f46b463366645962738803bfe0c216b6c964b7 authorAndrzej Rybczak <andrzej@rybczak.net> dateFri 10 Dec 2021, 00:55 (5 years ago) parentb702e62
6 files changed+41−98
compare with master
unifiedsplit
effectful-core/src/Effectful/Internal/Monad.hs−5 effectful-core/src/Effectful/Internal/Unlift.hs+13−56 effectful-core/src/Effectful/Monad.hs−1 effectful/effectful.cabal−1 effectful/src/Effectful.hs−1 effectful/tests/UnliftTests.hs+28−34
effectful-core/src/Effectful/Internal/Monad.hs−5
@@ -33,7 +33,6 @@ module Effectful.Internal.Monad
3333 , unliftStrategy
3434 , withUnliftStrategy
3535 , withEffToIO
36− , UnliftError(..)
3736
3837 --- *** Low-level helpers
3938 , seqUnliftIO
@@ -177,10 +176,6 @@ withEffToIO f = unliftStrategy >>= \case
177176 unsafeEff $ \es -> concUnliftIO es p b f
178177
179178-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
180−--
181−-- Exceptions thrown by this function:
182−--
183−-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
184179seqUnliftIO
185180 :: HasCallStack
186181 => Env es
effectful-core/src/Effectful/Internal/Unlift.hs+13−56
@@ -17,13 +17,9 @@ module Effectful.Internal.Unlift
1717 , concUnlift
1818 , ephemeralConcUnlift
1919 , persistentConcUnlift
20−
21− -- * Unlifting errors
22− , UnliftError(..)
2320 ) where
2421
2522import Control.Concurrent
26−import Control.Exception
2723import Control.Monad
2824import GHC.Conc.Sync (ThreadId(..))
2925import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -96,10 +92,6 @@ data Limit
9692-- Unlift functions
9793
9894-- | Sequential unlift.
99−--
100−-- Exceptions thrown by this function:
101−--
102−-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
10395seqUnlift
10496 :: HasCallStack
10597 => ((forall r. m r -> IO r) -> IO a)
@@ -112,7 +104,9 @@ seqUnlift k es unEff = do
112104 tid <- myThreadId
113105 if tid `eqThreadId` tid0
114106 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)."
116110
117111-- | Concurrent unlift for various strategies and limits.
118112concUnlift
@@ -134,11 +128,6 @@ concUnlift Persistent Unlimited k =
134128
135129-- | Concurrent unlift that doesn't preserve the environment between calls to
136130-- the unlifting function in threads other than its creator.
137−--
138−-- Exceptions thrown by this function:
139−--
140−-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
141−-- - 'ExceededNumberOfUses' if the unlift function is called too often.
142131ephemeralConcUnlift
143132 :: HasCallStack
144133 => Int
@@ -149,7 +138,7 @@ ephemeralConcUnlift
149138 -> IO a
150139ephemeralConcUnlift uses k es0 unEff = do
151140 unless (uses > 0) $ do
152− throwIO $ InvalidNumberOfUses uses
141+ error $ "Invalid number of uses: " ++ show uses
153142 tid0 <- myThreadId
154143 -- Create a copy of the environment as a template for the other threads to
155144 -- use. This can't be done from inside the callback as the environment might
@@ -160,7 +149,10 @@ ephemeralConcUnlift uses k es0 unEff = do
160149 es <- myThreadId >>= \case
161150 tid | tid0 `eqThreadId` tid -> pure es0
162151 _ -> 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."
164156 1 -> pure (0, esTemplate)
165157 n -> do
166158 let newUses = n - 1
@@ -170,12 +162,6 @@ ephemeralConcUnlift uses k es0 unEff = do
170162
171163-- | Concurrent unlift that preserves the environment between calls to the
172164-- unlifting function within a particular thread.
173−--
174−-- Exceptions thrown by this function:
175−--
176−-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
177−-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
178−-- threads.
179165persistentConcUnlift
180166 :: HasCallStack
181167 => Bool
@@ -187,7 +173,7 @@ persistentConcUnlift
187173 -> IO a
188174persistentConcUnlift cleanUp threads k es0 unEff = do
189175 unless (threads > 0) $ do
190− throwIO $ InvalidNumberOfThreads threads
176+ error $ "Invalid number of threads: " ++ show threads
191177 tid0 <- myThreadId
192178 -- Create a copy of the environment as a template for the other threads to
193179 -- 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
205191 case mes of
206192 Just es -> pure (te, es)
207193 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."
209198 1 -> do
210199 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
211200 let newEntries = ThreadEntries
@@ -223,38 +212,6 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
223212 newEntries `seq` pure (newEntries, es)
224213 unEff m es
225214
226−----------------------------------------
227−-- Errors
228−
229−-- | An type used for errors occuring in unlifting functions.
230−--
231−-- Use the 'displayException' method of the 'Exception' type class to get
232−-- descriptive error messages.
233−data UnliftError
234− = InvalidNumberOfThreads !Int
235− | InvalidNumberOfUses !Int
236− | InvalidUseOfSeqUnlift
237− | ExceededNumberOfThreads !Int
238− | ExceededNumberOfUses !Int
239− deriving (Eq, Generic, Show)
240−
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)."
257−
258215----------------------------------------
259216-- Data types
260217
effectful-core/src/Effectful/Monad.hs−1
@@ -18,7 +18,6 @@ module Effectful.Monad
1818 , unliftStrategy
1919 , withUnliftStrategy
2020 , withEffToIO
21− , UnliftError(..)
2221
2322 -- * Re-exports
2423 , MonadIO(..)
effectful/effectful.cabal−1
@@ -118,7 +118,6 @@ test-suite test
118118 , effectful-core
119119 , exceptions
120120 , lifted-base
121− , optics-core >= 0.4
122121 , tasty
123122 , tasty-hunit
124123 , unliftio
effectful/src/Effectful.hs−1
@@ -22,7 +22,6 @@ module Effectful
2222 , unliftStrategy
2323 , withUnliftStrategy
2424 , withEffToIO
25− , UnliftError(..)
2625
2726 -- * 'Effect' handlers
2827
effectful/tests/UnliftTests.hs+28−34
@@ -1,7 +1,7 @@
11{-# LANGUAGE OverloadedLabels #-}
22module UnliftTests (unliftTests) where
33
4−import Optics.Core
4+import Control.Exception
55import Test.Tasty
66import Test.Tasty.HUnit
77import qualified UnliftIO.Async as A
@@ -34,43 +34,38 @@ test_resetStrategy = runEff $ do
3434
3535test_seqUnliftInNewThread :: Assertion
3636test_seqUnliftInNewThread = runEff $ do
37− assertThrowsUnliftError "InvalidUseOfSeqUnlift error"
38− (has #_InvalidUseOfSeqUnlift) $ do
39− withUnliftStrategy SeqUnlift $ do
40− withEffToIO $ \runInIO -> do
41− inThread $ runInIO $ return ()
37+ assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do
38+ withUnliftStrategy SeqUnlift $ do
39+ withEffToIO $ \runInIO -> do
40+ inThread $ runInIO $ return ()
4241
4342test_ephemeralInvalid :: Assertion
4443test_ephemeralInvalid = runEff $ do
45− assertThrowsUnliftError "InvalidNumberOfUses error"
46− (has #_InvalidNumberOfUses) $ do
47− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
48− withEffToIO $ \_ -> return ()
44+ assertThrowsUnliftError "InvalidNumberOfUses error" $ do
45+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
46+ withEffToIO $ \_ -> return ()
4947
5048test_ephemeralSameThread :: Assertion
5149test_ephemeralSameThread = runEff $ do
52− assertThrowsUnliftError "ExceededNumberOfUses error"
53− (has #_ExceededNumberOfUses) $ do
54− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
55− withEffToIO $ \runInIO -> inThread $ do
56− runInIO $ return ()
57− runInIO $ return ()
50+ assertThrowsUnliftError "ExceededNumberOfUses error" $ do
51+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
52+ withEffToIO $ \runInIO -> inThread $ do
53+ runInIO $ return ()
54+ runInIO $ return ()
5855
5956test_ephemeralMultipleThreads :: Assertion
6057test_ephemeralMultipleThreads = runEff $ do
61− assertThrowsUnliftError "ExceededNumberOfUses error"
62− (has #_ExceededNumberOfUses) $ do
63− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
64− withEffToIO $ \runInIO -> do
65− inThread $ runInIO $ return ()
66− inThread $ runInIO $ return ()
58+ assertThrowsUnliftError "ExceededNumberOfUses error" $ do
59+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
60+ withEffToIO $ \runInIO -> do
61+ inThread $ runInIO $ return ()
62+ inThread $ runInIO $ return ()
6763
6864test_persistentInvalid :: Assertion
6965test_persistentInvalid = runEff $ do
70− assertThrowsUnliftError "InvalidNumberOfThreads error"
71− (has #_InvalidNumberOfThreads) $ do
72− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
73− withEffToIO $ \_ -> return ()
66+ assertThrowsUnliftError "InvalidNumberOfThreads error" $ do
67+ withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
68+ withEffToIO $ \_ -> return ()
7469
7570test_persistentSameThread :: Assertion
7671test_persistentSameThread = runEff $ do
@@ -81,20 +76,19 @@ test_persistentSameThread = runEff $ do
8176
8277test_persistentMultipleThreads :: Assertion
8378test_persistentMultipleThreads = runEff $ do
84− assertThrowsUnliftError "ExceededNumberOfThreads error"
85− (has #_ExceededNumberOfThreads) $ do
86− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
87− withEffToIO $ \runInIO -> do
88− inThread $ runInIO $ return ()
89− inThread $ runInIO $ return ()
79+ assertThrowsUnliftError "ExceededNumberOfThreads error" $ do
80+ withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
81+ withEffToIO $ \runInIO -> do
82+ inThread $ runInIO $ return ()
83+ inThread $ runInIO $ return ()
9084
9185----------------------------------------
9286-- Helpers
9387
9488assertThrowsUnliftError
9589 :: IOE :> es
96− => String -> (UnliftError -> Bool) -> Eff es a -> Eff es ()
97−assertThrowsUnliftError = U.assertThrows
90+ => String -> Eff es a -> Eff es ()
91+assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)
9892
9993inThread :: IO a -> IO a
10094inThread k = A.async k >>= A.wait