on master help sign in
Rename and move around a few functions
commita01f6e307e566b300352de50ca2579fafbb8ad95 authorAndrzej Rybczak <andrzej@rybczak.net> dateMon 6 Dec 2021, 21:11 (5 years ago) parentf685d65
4 files changed+92−92
effectful-core/src/Effectful/Dispatch/Dynamic.hs+14−14 effectful-core/src/Effectful/Dispatch/Static.hs+35 effectful-core/src/Effectful/Internal/Monad.hs+24−59 effectful-core/src/Effectful/Internal/Unlift.hs+19−19
effectful-core/src/Effectful/Dispatch/Dynamic.hs+14−14
@@ -77,7 +77,7 @@ localSeqUnlift
7777 -- ^ Continuation with the unlifting function in scope.
7878 -> Eff es a
7979localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
80− seqUnliftEff les $ \unlift -> do
80+ seqUnliftIO les $ \unlift -> do
8181 (`unEff` es) $ k $ unsafeEff_ . unlift
8282
8383-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
@@ -89,7 +89,7 @@ localSeqUnliftIO
8989 -> ((forall r. Eff localEs r -> IO r) -> IO a)
9090 -- ^ Continuation with the unlifting function in scope.
9191 -> Eff es a
92−localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
92+localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k
9393
9494-- | Create a local unlifting function with the given strategy.
9595localUnlift
@@ -102,10 +102,10 @@ localUnlift
102102 -> Eff es a
103103localUnlift (LocalEnv les) strategy k = case strategy of
104104 SeqUnlift -> unsafeEff $ \es -> do
105− seqUnliftEff les $ \unlift -> do
105+ seqUnliftIO les $ \unlift -> do
106106 (`unEff` es) $ k $ unsafeEff_ . unlift
107107 ConcUnlift p l -> unsafeEff $ \es -> do
108− concUnliftEff les p l $ \unlift -> do
108+ concUnliftIO les p l $ \unlift -> do
109109 (`unEff` es) $ k $ unsafeEff_ . unlift
110110
111111-- | Create a local unlifting function with the given strategy.
@@ -118,8 +118,8 @@ localUnliftIO
118118 -- ^ Continuation with the unlifting function in scope.
119119 -> Eff es a
120120localUnliftIO (LocalEnv les) strategy k = case strategy of
121− SeqUnlift -> liftIO $ seqUnliftEff les k
122− ConcUnlift p l -> liftIO $ concUnliftEff les p l k
121+ SeqUnlift -> liftIO $ seqUnliftIO les k
122+ ConcUnlift p l -> liftIO $ concUnliftIO les p l k
123123
124124-- | Utility for lifting 'Eff' operations of type
125125--
@@ -142,7 +142,7 @@ withLiftMap !_ k = unsafeEff $ \es -> do
142142 -- The LocalEnv parameter is not used, but we need it to constraint the
143143 -- localEs type variable. It's also strict so that callers don't cheat.
144144 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
145− seqUnliftEff localEs $ \unlift -> do
145+ seqUnliftIO localEs $ \unlift -> do
146146 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
147147
148148-- | Utility for lifting 'IO' operations of type
@@ -180,7 +180,7 @@ withLiftMapIO
180180withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
181181 -- The LocalEnv parameter is not used, but we need it to constraint the
182182 -- localEs type variable. It's also strict so that callers don't cheat.
183− seqUnliftEff es $ \unlift -> mapIO $ unlift m
183+ seqUnliftIO es $ \unlift -> mapIO $ unlift m
184184
185185----------------------------------------
186186-- Bidirectional lifts
@@ -202,12 +202,12 @@ localLiftUnlift
202202 -> Eff es a
203203localLiftUnlift (LocalEnv les) strategy k = case strategy of
204204 SeqUnlift -> unsafeEff $ \es -> do
205− seqUnliftEff es $ \unliftEs -> do
206− seqUnliftEff les $ \unliftLocalEs -> do
205+ seqUnliftIO es $ \unliftEs -> do
206+ seqUnliftIO les $ \unliftLocalEs -> do
207207 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
208208 ConcUnlift p l -> unsafeEff $ \es -> do
209− concUnliftEff es p l $ \unliftEs -> do
210− concUnliftEff les p l $ \unliftLocalEs -> do
209+ concUnliftIO es p l $ \unliftEs -> do
210+ concUnliftIO les p l $ \unliftLocalEs -> do
211211 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
212212
213213-- | Create a local unlifting function with the given strategy along with an
@@ -227,8 +227,8 @@ localLiftUnliftIO
227227 -- ^ Continuation with the lifting and unlifting function in scope.
228228 -> Eff es a
229229localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
230− SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_
231− ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
230+ SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
231+ ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
232232
233233-- $setup
234234-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+35
@@ -46,6 +46,41 @@ module Effectful.Dispatch.Static
4646 , unEff
4747 ) where
4848
49+import GHC.Stack (HasCallStack)
50+
4951import Effectful.Internal.Effect
5052import Effectful.Internal.Env
5153import Effectful.Internal.Monad
54+
55+-- | Utility for lifting 'IO' operations of type
56+--
57+-- @'IO' a -> 'IO' b@
58+--
59+-- to
60+--
61+-- @'Eff' es a -> 'Eff' es b@
62+--
63+-- This function is __unsafe__ because:
64+--
65+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
66+-- operations.
67+--
68+-- - The 'IO' operation must not run its argument in a separate thread, but it's
69+-- not checked anywhere.
70+unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
71+unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
72+
73+-- | Utility for running 'Eff' computations locally in the 'IO' monad.
74+--
75+-- This function is __unsafe__ because:
76+--
77+-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
78+-- operations.
79+--
80+-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
81+-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
82+unsafeUnliftIO
83+ :: HasCallStack
84+ => ((forall r. Eff es r -> IO r) -> IO a)
85+ -> Eff es a
86+unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
effectful-core/src/Effectful/Internal/Monad.hs+24−59
@@ -36,10 +36,8 @@ module Effectful.Internal.Monad
3636 , UnliftError(..)
3737
3838 --- *** Low-level helpers
39− , unsafeLiftMapIO
40− , unsafeUnliftIO
41− , seqUnliftEff
42− , concUnliftEff
39+ , seqUnliftIO
40+ , concUnliftIO
4341
4442 -- * Effects
4543
@@ -148,41 +146,8 @@ unsafeEff m = Eff (oneShot m)
148146unsafeEff_ :: IO a -> Eff es a
149147unsafeEff_ m = unsafeEff $ \_ -> m
150148
151−-- | Utility for lifting 'IO' operations of type
152−--
153−-- @'IO' a -> 'IO' b@
154−--
155−-- to
156−--
157−-- @'Eff' es a -> 'Eff' es b@
158−--
159−-- This function is __unsafe__ because:
160−--
161−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
162−-- operations.
163−--
164−-- - The 'IO' operation must not run its argument in a separate thread, but it's
165−-- not checked anywhere.
166−unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
167−unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
168−
169−-- | Utility for running 'Eff' computations locally in the 'IO' monad.
170−--
171−-- This function is __unsafe__ because:
172−--
173−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
174−-- operations.
175−--
176−-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
177−-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
178−unsafeUnliftIO
179− :: HasCallStack
180− => ((forall r. Eff es r -> IO r) -> IO a)
181− -> Eff es a
182−unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
183−
184149----------------------------------------
185−-- Unlifting Eff
150+-- Unlifting IO
186151
187152-- | Get the current 'UnliftStrategy'.
188153unliftStrategy :: IOE :> es => Eff es UnliftStrategy
@@ -194,44 +159,44 @@ unliftStrategy = do
194159withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
195160withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
196161
162+-- | Create an unlifting function with the current 'UnliftStrategy'.
163+--
164+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
165+-- constraint for accurate stack traces in case an insufficiently powerful
166+-- 'UnliftStrategy' is used and the unlifting function fails.
167+--
168+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
169+withEffToIO
170+ :: (HasCallStack, IOE :> es)
171+ => ((forall r. Eff es r -> IO r) -> IO a)
172+ -- ^ Continuation with the unlifting function in scope.
173+ -> Eff es a
174+withEffToIO f = unliftStrategy >>= \case
175+ SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f
176+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
177+ unsafeEff $ \es -> concUnliftIO es p b f
178+
197179-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
198180--
199181-- Exceptions thrown by this function:
200182--
201183-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
202−seqUnliftEff
184+seqUnliftIO
203185 :: HasCallStack
204186 => Env es
205187 -> ((forall r. Eff es r -> IO r) -> IO a)
206188 -> IO a
207−seqUnliftEff es k = seqUnliftIO k es unEff
189+seqUnliftIO es k = seqUnlift k es unEff
208190
209191-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
210−concUnliftEff
192+concUnliftIO
211193 :: HasCallStack
212194 => Env es
213195 -> Persistence
214196 -> Limit
215197 -> ((forall r. Eff es r -> IO r) -> IO a)
216198 -> IO a
217−concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff
218−
219−-- | Create an unlifting function with the current 'UnliftStrategy'.
220−--
221−-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
222−-- constraint for accurate stack traces in case an insufficiently powerful
223−-- 'UnliftStrategy' is used and the unlifting function fails.
224−--
225−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
226−withEffToIO
227− :: (HasCallStack, IOE :> es)
228− => ((forall r. Eff es r -> IO r) -> IO a)
229− -- ^ Continuation with the unlifting function in scope.
230− -> Eff es a
231−withEffToIO f = unliftStrategy >>= \case
232− SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
233− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
234− unsafeEff $ \es -> concUnliftEff es p b f
199+concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
235200
236201----------------------------------------
237202-- Base
effectful-core/src/Effectful/Internal/Unlift.hs+19−19
@@ -13,10 +13,10 @@ module Effectful.Internal.Unlift
1313 , Limit(..)
1414
1515 -- * Unlifting functions
16− , seqUnliftIO
17− , concUnliftIO
18− , ephemeralConcUnliftIO
19− , persistentConcUnliftIO
16+ , seqUnlift
17+ , concUnlift
18+ , ephemeralConcUnlift
19+ , persistentConcUnlift
2020
2121 -- * Unlifting errors
2222 , UnliftError(..)
@@ -100,13 +100,13 @@ data Limit
100100-- Exceptions thrown by this function:
101101--
102102-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
103−seqUnliftIO
103+seqUnlift
104104 :: HasCallStack
105105 => ((forall r. m r -> IO r) -> IO a)
106106 -> Env es
107107 -> (forall r. m r -> Env es -> IO r)
108108 -> IO a
109−seqUnliftIO k es unEff = do
109+seqUnlift k es unEff = do
110110 tid0 <- myThreadId
111111 k $ \m -> do
112112 tid <- myThreadId
@@ -115,7 +115,7 @@ seqUnliftIO k es unEff = do
115115 else throwIO InvalidUseOfSeqUnlift
116116
117117-- | Concurrent unlift for various strategies and limits.
118−concUnliftIO
118+concUnlift
119119 :: HasCallStack
120120 => Persistence
121121 -> Limit
@@ -123,14 +123,14 @@ concUnliftIO
123123 -> Env es
124124 -> (forall r. m r -> Env es -> IO r)
125125 -> IO a
126−concUnliftIO Ephemeral (Limited uses) k =
127− ephemeralConcUnliftIO uses k
128−concUnliftIO Ephemeral Unlimited k =
129− ephemeralConcUnliftIO maxBound k
130−concUnliftIO Persistent (Limited threads) k =
131− persistentConcUnliftIO False threads k
132−concUnliftIO Persistent Unlimited k =
133− persistentConcUnliftIO True maxBound k
126+concUnlift Ephemeral (Limited uses) k =
127+ ephemeralConcUnlift uses k
128+concUnlift Ephemeral Unlimited k =
129+ ephemeralConcUnlift maxBound k
130+concUnlift Persistent (Limited threads) k =
131+ persistentConcUnlift False threads k
132+concUnlift Persistent Unlimited k =
133+ persistentConcUnlift True maxBound k
134134
135135-- | Concurrent unlift that doesn't preserve the environment between calls to
136136-- the unlifting function in threads other than its creator.
@@ -139,7 +139,7 @@ concUnliftIO Persistent Unlimited k =
139139--
140140-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
141141-- - 'ExceededNumberOfUses' if the unlift function is called too often.
142−ephemeralConcUnliftIO
142+ephemeralConcUnlift
143143 :: HasCallStack
144144 => Int
145145 -- ^ Number of permitted uses of the unlift function.
@@ -147,7 +147,7 @@ ephemeralConcUnliftIO
147147 -> Env es
148148 -> (forall r. m r -> Env es -> IO r)
149149 -> IO a
150−ephemeralConcUnliftIO uses k es0 unEff = do
150+ephemeralConcUnlift uses k es0 unEff = do
151151 unless (uses > 0) $ do
152152 throwIO $ InvalidNumberOfUses uses
153153 tid0 <- myThreadId
@@ -176,7 +176,7 @@ ephemeralConcUnliftIO uses k es0 unEff = do
176176-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
177177-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
178178-- threads.
179−persistentConcUnliftIO
179+persistentConcUnlift
180180 :: HasCallStack
181181 => Bool
182182 -> Int
@@ -185,7 +185,7 @@ persistentConcUnliftIO
185185 -> Env es
186186 -> (forall r. m r -> Env es -> IO r)
187187 -> IO a
188−persistentConcUnliftIO cleanUp threads k es0 unEff = do
188+persistentConcUnlift cleanUp threads k es0 unEff = do
189189 unless (threads > 0) $ do
190190 throwIO $ InvalidNumberOfThreads threads
191191 tid0 <- myThreadId