git.iko.soy/effectful
on master help sign in
Add unsafeUnliftIO as a helper for unlifting Eff operations
commit351169f9acab083ff582cc37bc7c8e36b0801520 authorAndrzej Rybczak <andrzej@rybczak.net> dateSun 28 Nov 2021, 09:58 (5 years ago) parentc85a3bb
6 files changed+48−23
compare with master
unifiedsplit
effectful-core/src/Effectful/Internal/Monad.hs+16 effectful/src/Effectful/Concurrent/MVar.hs+14−7 effectful/src/Effectful/Concurrent/STM.hs+4−2 effectful/src/Effectful/FileSystem.hs+4−4 effectful/src/Effectful/Process.hs+2−2 effectful/src/Effectful/Temporary.hs+8−8
effectful-core/src/Effectful/Internal/Monad.hs+16
@@ -37,6 +37,7 @@ module Effectful.Internal.Monad
3737
3838 --- *** Low-level helpers
3939 , unsafeLiftMapIO
40+ , unsafeUnliftIO
4041 , seqUnliftEff
4142 , concUnliftEff
4243
@@ -165,6 +166,21 @@ unsafeEff_ m = unsafeEff $ \_ -> m
165166unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
166167unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
167168
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+
168184----------------------------------------
169185-- Unlifting Eff
170186
effectful/src/Effectful/Concurrent/MVar.hs+14−7
@@ -70,28 +70,35 @@ tryReadMVar = unsafeEff_ . M.tryReadMVar
7070
7171-- | Lifted 'M.withMVar'.
7272withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
73−withMVar var f = unsafeEff $ \es -> M.withMVar var ((`unEff` es) . f)
73+withMVar var f = unsafeUnliftIO $ \unlift -> do
74+ M.withMVar var $ unlift . f
7475
7576-- | Lifted 'M.withMVarMasked'.
7677withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
77−withMVarMasked var f = unsafeEff $ \es -> M.withMVarMasked var ((`unEff` es) . f)
78+withMVarMasked var f = unsafeUnliftIO $ \unlift -> do
79+ M.withMVarMasked var $ unlift . f
7880
7981-- | Lifted 'M.modifyMVar_'.
8082modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
81−modifyMVar_ var f = unsafeEff $ \es -> M.modifyMVar_ var ((`unEff` es) . f)
83+modifyMVar_ var f = unsafeUnliftIO $ \unlift -> do
84+ M.modifyMVar_ var $ unlift . f
8285
8386-- | Lifted 'M.modifyMVar'.
8487modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
85−modifyMVar var f = unsafeEff $ \es -> M.modifyMVar var ((`unEff` es) . f)
88+modifyMVar var f = unsafeUnliftIO $ \unlift -> do
89+ M.modifyMVar var $ unlift . f
8690
8791-- | Lifted 'M.modifyMVarMasked_'.
8892modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
89−modifyMVarMasked_ var f = unsafeEff $ \es -> M.modifyMVarMasked_ var ((`unEff` es) . f)
93+modifyMVarMasked_ var f = unsafeUnliftIO $ \unlift -> do
94+ M.modifyMVarMasked_ var $ unlift . f
9095
9196-- | Lifted 'M.modifyMVarMasked'.
9297modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
93−modifyMVarMasked var f = unsafeEff $ \es -> M.modifyMVarMasked var ((`unEff` es) . f)
98+modifyMVarMasked var f = unsafeUnliftIO $ \unlift -> do
99+ M.modifyMVarMasked var $ unlift . f
94100
95101-- | Lifted 'M.mkWeakMVar'.
96102mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
97−mkWeakMVar var f = unsafeEff $ \es -> M.mkWeakMVar var ((`unEff` es) f)
103+mkWeakMVar var f = unsafeUnliftIO $ \unlift -> do
104+ M.mkWeakMVar var $ unlift f
effectful/src/Effectful/Concurrent/STM.hs+4−2
@@ -110,7 +110,8 @@ registerDelay = unsafeEff_ . STM.registerDelay
110110
111111-- | Lifted version of 'STM.mkWeakTVar'
112112mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
113−mkWeakTVar var final = unsafeEff $ STM.mkWeakTVar var . unEff final
113+mkWeakTVar var final = unsafeUnliftIO $ \unlift -> do
114+ STM.mkWeakTVar var $ unlift final
114115
115116-- | Lifted version of 'STM.newTMVarIO'
116117newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
@@ -122,7 +123,8 @@ newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO
122123
123124-- | Lifted version of 'STM.mkWeakTMVar'
124125mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
125−mkWeakTMVar var final = unsafeEff $ STM.mkWeakTMVar var . unEff final
126+mkWeakTMVar var final = unsafeUnliftIO $ \unlift -> do
127+ STM.mkWeakTMVar var $ unlift final
126128
127129-- | Lifted version of 'STM.newTChanIO'
128130newTChanIO :: Concurrent :> es => Eff es (TChan a)
effectful/src/Effectful/FileSystem.hs+4−4
@@ -276,8 +276,8 @@ findFileWith
276276 -> [FilePath]
277277 -> String
278278 -> Eff es (Maybe FilePath)
279−findFileWith p dirs n = unsafeEff $ \es -> do
280− D.findFileWith ((`unEff` es) . p) dirs n
279+findFileWith p dirs n = unsafeUnliftIO $ \unlift -> do
280+ D.findFileWith (unlift . p) dirs n
281281
282282-- | Lifted 'D.findFilesWith'.
283283findFilesWith
@@ -286,8 +286,8 @@ findFilesWith
286286 -> [FilePath]
287287 -> String
288288 -> Eff es [FilePath]
289−findFilesWith p dirs ns = unsafeEff $ \es -> do
290− D.findFilesWith ((`unEff` es) . p) dirs ns
289+findFilesWith p dirs ns = unsafeUnliftIO $ \unlift -> do
290+ D.findFilesWith (unlift . p) dirs ns
291291
292292----------------------------------------
293293-- Symbolic links
effectful/src/Effectful/Process.hs+2−2
@@ -129,8 +129,8 @@ withCreateProcess
129129 => P.CreateProcess
130130 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
131131 -> Eff es a
132−withCreateProcess cp cb = unsafeEff $ \es -> do
133− P.withCreateProcess cp $ \inh outh errh ph -> unEff (cb inh outh errh ph) es
132+withCreateProcess cp cb = unsafeUnliftIO $ \unlift -> do
133+ P.withCreateProcess cp $ \inh outh errh ph -> unlift $ cb inh outh errh ph
134134
135135-- | Lifted 'P.cleanupProcess'.
136136cleanupProcess
effectful/src/Effectful/Temporary.hs+8−8
@@ -29,8 +29,8 @@ withSystemTempFile
2929 -> (FilePath -> Handle -> Eff es a)
3030 -- ^ Callback that can use the file.
3131 -> Eff es a
32−withSystemTempFile template action = unsafeEff $ \es -> do
33− T.withSystemTempFile template $ \fp handle -> unEff (action fp handle) es
32+withSystemTempFile template action = unsafeUnliftIO $ \unlift -> do
33+ T.withSystemTempFile template $ \fp handle -> unlift $ action fp handle
3434
3535-- | Lifted 'T.withSystemTempDirectory'.
3636withSystemTempDirectory
@@ -40,8 +40,8 @@ withSystemTempDirectory
4040 -> (FilePath -> Eff es a)
4141 -- ^ Callback that can use the directory.
4242 -> Eff es a
43−withSystemTempDirectory template action = unsafeEff $ \es -> do
44− T.withSystemTempDirectory template $ \fp -> unEff (action fp) es
43+withSystemTempDirectory template action = unsafeUnliftIO $ \unlift -> do
44+ T.withSystemTempDirectory template $ \fp -> unlift $ action fp
4545
4646-- | Lifted 'T.withTempFile'.
4747withTempFile
@@ -53,8 +53,8 @@ withTempFile
5353 -> (FilePath -> Handle -> Eff es a)
5454 -- ^ Callback that can use the file.
5555 -> Eff es a
56−withTempFile tmpDir template action = unsafeEff $ \es -> do
57− T.withTempFile tmpDir template $ \fp handle -> unEff (action fp handle) es
56+withTempFile tmpDir template action = unsafeUnliftIO $ \unlift -> do
57+ T.withTempFile tmpDir template $ \fp handle -> unlift $ action fp handle
5858
5959-- | Lifted 'T.withTempDirectory'.
6060withTempDirectory
@@ -66,5 +66,5 @@ withTempDirectory
6666 -> (FilePath -> Eff es a)
6767 -- ^ Callback that can use the directory.
6868 -> Eff es a
69−withTempDirectory tmpDir template action = unsafeEff $ \es -> do
70− T.withTempDirectory tmpDir template $ \fp -> unEff (action fp) es
69+withTempDirectory tmpDir template action = unsafeUnliftIO $ \unlift -> do
70+ T.withTempDirectory tmpDir template $ \fp -> unlift $ action fp