git.iko.soy/effectful
on master help sign in
Add unsafeUnliftIO as a helper for unlifting Eff operations
351169fAndrzej Rybczak
effectful-core/src/Effectful/Internal/Monad.hs+16
compare with master
unifiedsplit
@@ -37,6 +37,7 @@ module Effectful.Internal.Monad
37
37
38 --- *** Low-level helpers
38 --- *** Low-level helpers
39 , unsafeLiftMapIO
39 , unsafeLiftMapIO
40+ , unsafeUnliftIO
40 , seqUnliftEff
41 , seqUnliftEff
41 , concUnliftEff
42 , concUnliftEff
42
43
@@ -165,6 +166,21 @@ unsafeEff_ m = unsafeEff $ \_ -> m
165unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
166unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
166unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
167unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
167
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+
168----------------------------------------
184----------------------------------------
169-- Unlifting Eff
185-- Unlifting Eff
170
186
effectful/src/Effectful/Concurrent/MVar.hs+14−7
@@ -70,28 +70,35 @@ tryReadMVar = unsafeEff_ . M.tryReadMVar
70
70
71-- | Lifted 'M.withMVar'.
71-- | Lifted 'M.withMVar'.
72withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
72withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
73+withMVar var f = unsafeUnliftIO $ \unlift -> do
73−withMVar var f = unsafeEff $ \es -> M.withMVar var ((`unEff` es) . f)
74+ M.withMVar var $ unlift . f
74
75
75-- | Lifted 'M.withMVarMasked'.
76-- | Lifted 'M.withMVarMasked'.
76withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
77withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
78+withMVarMasked var f = unsafeUnliftIO $ \unlift -> do
77−withMVarMasked var f = unsafeEff $ \es -> M.withMVarMasked var ((`unEff` es) . f)
79+ M.withMVarMasked var $ unlift . f
78
80
79-- | Lifted 'M.modifyMVar_'.
81-- | Lifted 'M.modifyMVar_'.
80modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
82modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
83+modifyMVar_ var f = unsafeUnliftIO $ \unlift -> do
81−modifyMVar_ var f = unsafeEff $ \es -> M.modifyMVar_ var ((`unEff` es) . f)
84+ M.modifyMVar_ var $ unlift . f
82
85
83-- | Lifted 'M.modifyMVar'.
86-- | Lifted 'M.modifyMVar'.
84modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
87modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
88+modifyMVar var f = unsafeUnliftIO $ \unlift -> do
85−modifyMVar var f = unsafeEff $ \es -> M.modifyMVar var ((`unEff` es) . f)
89+ M.modifyMVar var $ unlift . f
86
90
87-- | Lifted 'M.modifyMVarMasked_'.
91-- | Lifted 'M.modifyMVarMasked_'.
88modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
92modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
93+modifyMVarMasked_ var f = unsafeUnliftIO $ \unlift -> do
89−modifyMVarMasked_ var f = unsafeEff $ \es -> M.modifyMVarMasked_ var ((`unEff` es) . f)
94+ M.modifyMVarMasked_ var $ unlift . f
90
95
91-- | Lifted 'M.modifyMVarMasked'.
96-- | Lifted 'M.modifyMVarMasked'.
92modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
97modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
98+modifyMVarMasked var f = unsafeUnliftIO $ \unlift -> do
93−modifyMVarMasked var f = unsafeEff $ \es -> M.modifyMVarMasked var ((`unEff` es) . f)
99+ M.modifyMVarMasked var $ unlift . f
94
100
95-- | Lifted 'M.mkWeakMVar'.
101-- | Lifted 'M.mkWeakMVar'.
96mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
102mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
103+mkWeakMVar var f = unsafeUnliftIO $ \unlift -> do
97−mkWeakMVar var f = unsafeEff $ \es -> M.mkWeakMVar var ((`unEff` es) f)
104+ M.mkWeakMVar var $ unlift f
effectful/src/Effectful/Concurrent/STM.hs+4−2
@@ -110,7 +110,8 @@ registerDelay = unsafeEff_ . STM.registerDelay
110
110
111-- | Lifted version of 'STM.mkWeakTVar'
111-- | Lifted version of 'STM.mkWeakTVar'
112mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
112mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
113+mkWeakTVar var final = unsafeUnliftIO $ \unlift -> do
113−mkWeakTVar var final = unsafeEff $ STM.mkWeakTVar var . unEff final
114+ STM.mkWeakTVar var $ unlift final
114
115
115-- | Lifted version of 'STM.newTMVarIO'
116-- | Lifted version of 'STM.newTMVarIO'
116newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
117newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
@@ -122,7 +123,8 @@ newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO
122
123
123-- | Lifted version of 'STM.mkWeakTMVar'
124-- | Lifted version of 'STM.mkWeakTMVar'
124mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
125mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
126+mkWeakTMVar var final = unsafeUnliftIO $ \unlift -> do
125−mkWeakTMVar var final = unsafeEff $ STM.mkWeakTMVar var . unEff final
127+ STM.mkWeakTMVar var $ unlift final
126
128
127-- | Lifted version of 'STM.newTChanIO'
129-- | Lifted version of 'STM.newTChanIO'
128newTChanIO :: Concurrent :> es => Eff es (TChan a)
130newTChanIO :: Concurrent :> es => Eff es (TChan a)
effectful/src/Effectful/FileSystem.hs+4−4
@@ -276,8 +276,8 @@ findFileWith
276 -> [FilePath]
276 -> [FilePath]
277 -> String
277 -> String
278 -> Eff es (Maybe FilePath)
278 -> Eff es (Maybe FilePath)
279−findFileWith p dirs n = unsafeEff $ \es -> do
279+findFileWith p dirs n = unsafeUnliftIO $ \unlift -> do
280− D.findFileWith ((`unEff` es) . p) dirs n
280+ D.findFileWith (unlift . p) dirs n
281
281
282-- | Lifted 'D.findFilesWith'.
282-- | Lifted 'D.findFilesWith'.
283findFilesWith
283findFilesWith
@@ -286,8 +286,8 @@ findFilesWith
286 -> [FilePath]
286 -> [FilePath]
287 -> String
287 -> String
288 -> Eff es [FilePath]
288 -> Eff es [FilePath]
289−findFilesWith p dirs ns = unsafeEff $ \es -> do
289+findFilesWith p dirs ns = unsafeUnliftIO $ \unlift -> do
290− D.findFilesWith ((`unEff` es) . p) dirs ns
290+ D.findFilesWith (unlift . p) dirs ns
291
291
292----------------------------------------
292----------------------------------------
293-- Symbolic links
293-- Symbolic links
effectful/src/Effectful/Process.hs+2−2
@@ -129,8 +129,8 @@ withCreateProcess
129 => P.CreateProcess
129 => P.CreateProcess
130 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
130 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
131 -> Eff es a
131 -> Eff es a
132−withCreateProcess cp cb = unsafeEff $ \es -> do
132+withCreateProcess cp cb = unsafeUnliftIO $ \unlift -> do
133− P.withCreateProcess cp $ \inh outh errh ph -> unEff (cb inh outh errh ph) es
133+ P.withCreateProcess cp $ \inh outh errh ph -> unlift $ cb inh outh errh ph
134
134
135-- | Lifted 'P.cleanupProcess'.
135-- | Lifted 'P.cleanupProcess'.
136cleanupProcess
136cleanupProcess
effectful/src/Effectful/Temporary.hs+8−8
@@ -29,8 +29,8 @@ withSystemTempFile
29 -> (FilePath -> Handle -> Eff es a)
29 -> (FilePath -> Handle -> Eff es a)
30 -- ^ Callback that can use the file.
30 -- ^ Callback that can use the file.
31 -> Eff es a
31 -> Eff es a
32−withSystemTempFile template action = unsafeEff $ \es -> do
32+withSystemTempFile template action = unsafeUnliftIO $ \unlift -> do
33− T.withSystemTempFile template $ \fp handle -> unEff (action fp handle) es
33+ T.withSystemTempFile template $ \fp handle -> unlift $ action fp handle
34
34
35-- | Lifted 'T.withSystemTempDirectory'.
35-- | Lifted 'T.withSystemTempDirectory'.
36withSystemTempDirectory
36withSystemTempDirectory
@@ -40,8 +40,8 @@ withSystemTempDirectory
40 -> (FilePath -> Eff es a)
40 -> (FilePath -> Eff es a)
41 -- ^ Callback that can use the directory.
41 -- ^ Callback that can use the directory.
42 -> Eff es a
42 -> Eff es a
43−withSystemTempDirectory template action = unsafeEff $ \es -> do
43+withSystemTempDirectory template action = unsafeUnliftIO $ \unlift -> do
44− T.withSystemTempDirectory template $ \fp -> unEff (action fp) es
44+ T.withSystemTempDirectory template $ \fp -> unlift $ action fp
45
45
46-- | Lifted 'T.withTempFile'.
46-- | Lifted 'T.withTempFile'.
47withTempFile
47withTempFile
@@ -53,8 +53,8 @@ withTempFile
53 -> (FilePath -> Handle -> Eff es a)
53 -> (FilePath -> Handle -> Eff es a)
54 -- ^ Callback that can use the file.
54 -- ^ Callback that can use the file.
55 -> Eff es a
55 -> Eff es a
56−withTempFile tmpDir template action = unsafeEff $ \es -> do
56+withTempFile tmpDir template action = unsafeUnliftIO $ \unlift -> do
57− T.withTempFile tmpDir template $ \fp handle -> unEff (action fp handle) es
57+ T.withTempFile tmpDir template $ \fp handle -> unlift $ action fp handle
58
58
59-- | Lifted 'T.withTempDirectory'.
59-- | Lifted 'T.withTempDirectory'.
60withTempDirectory
60withTempDirectory
@@ -66,5 +66,5 @@ withTempDirectory
66 -> (FilePath -> Eff es a)
66 -> (FilePath -> Eff es a)
67 -- ^ Callback that can use the directory.
67 -- ^ Callback that can use the directory.
68 -> Eff es a
68 -> Eff es a
69−withTempDirectory tmpDir template action = unsafeEff $ \es -> do
69+withTempDirectory tmpDir template action = unsafeUnliftIO $ \unlift -> do
70− T.withTempDirectory tmpDir template $ \fp -> unEff (action fp) es
70+ T.withTempDirectory tmpDir template $ \fp -> unlift $ action fp