on master help sign in
Add lifted version of Chan, MVar, STM, QSem and QSemN
commitbb6b861708c3a69ee52cff82eac671c1b92a6c5f authorAndrzej Rybczak <andrzej@rybczak.net> dateSat 27 Nov 2021, 12:57 (5 years ago) parente7bdc07
6 files changed+337
effectful/effectful.cabal+6 effectful/src/Effectful/Concurrent/Chan.hs+41 effectful/src/Effectful/Concurrent/MVar.hs+97 effectful/src/Effectful/Concurrent/QSem.hs+26 effectful/src/Effectful/Concurrent/QSemN.hs+26 effectful/src/Effectful/Concurrent/STM.hs+141
effectful/effectful.cabal+6
@@ -67,6 +67,7 @@ library
6767 , process
6868 , resourcet
6969 , time
70+ , stm >= 2.5.0.0
7071 , unliftio
7172
7273 hs-source-dirs: src
@@ -74,6 +75,11 @@ library
7475 exposed-modules: Effectful
7576 Effectful.Concurrent
7677 Effectful.Concurrent.Async
78+ Effectful.Concurrent.Chan
79+ Effectful.Concurrent.MVar
80+ Effectful.Concurrent.STM
81+ Effectful.Concurrent.QSem
82+ Effectful.Concurrent.QSemN
7783 Effectful.Environment
7884 Effectful.FileSystem
7985 Effectful.Process
effectful/src/Effectful/Concurrent/Chan.hsnew file+41
@@ -0,0 +1,41 @@
1+-- | Lifted version of "Control.Concurrent.Chan".
2+module Effectful.Concurrent.Chan
3+ ( Chan
4+ , newChan
5+ , writeChan
6+ , readChan
7+ , dupChan
8+ , getChanContents
9+ , writeList2Chan
10+ ) where
11+
12+import Control.Concurrent.Chan (Chan)
13+import qualified Control.Concurrent.Chan as C
14+
15+import Effectful.Concurrent.Internal
16+import Effectful.Internal.Effect
17+import Effectful.Internal.Monad
18+
19+-- | Lifted 'C.newChan'.
20+newChan :: Concurrent :> es => Eff es (Chan a)
21+newChan = unsafeEff_ C.newChan
22+
23+-- | Lifted 'C.writeChan'.
24+writeChan :: Concurrent :> es => Chan a -> a -> Eff es ()
25+writeChan c = unsafeEff_ . C.writeChan c
26+
27+-- | Lifted 'C.readChan'.
28+readChan :: Concurrent :> es => Chan a -> Eff es a
29+readChan = unsafeEff_ . C.readChan
30+
31+-- | Lifted 'C.dupChan'.
32+dupChan :: Concurrent :> es => Chan a -> Eff es (Chan a)
33+dupChan = unsafeEff_ . C.dupChan
34+
35+-- | Lifted 'C.getChanContents'.
36+getChanContents :: Concurrent :> es => Chan a -> Eff es [a]
37+getChanContents = unsafeEff_ . C.getChanContents
38+
39+-- | Lifted 'C.writeList2Chan'.
40+writeList2Chan :: Concurrent :> es => Chan a -> [a] -> Eff es ()
41+writeList2Chan c = unsafeEff_ . C.writeList2Chan c
effectful/src/Effectful/Concurrent/MVar.hsnew file+97
@@ -0,0 +1,97 @@
1+-- | Lifted version of "Control.Concurrent.MVar".
2+module Effectful.Concurrent.MVar
3+ ( MVar
4+ , newEmptyMVar
5+ , newMVar
6+ , takeMVar
7+ , putMVar
8+ , readMVar
9+ , swapMVar
10+ , tryTakeMVar
11+ , tryPutMVar
12+ , isEmptyMVar
13+ , withMVar
14+ , withMVarMasked
15+ , modifyMVar
16+ , modifyMVar_
17+ , modifyMVarMasked
18+ , modifyMVarMasked_
19+ , tryReadMVar
20+ , mkWeakMVar
21+ ) where
22+
23+import System.Mem.Weak (Weak)
24+import Control.Concurrent.MVar (MVar)
25+import qualified Control.Concurrent.MVar as M
26+
27+import Effectful.Concurrent.Internal
28+import Effectful.Internal.Effect
29+import Effectful.Internal.Monad
30+
31+-- | Lifted 'M.newEmptyMVar'.
32+newEmptyMVar :: Concurrent :> es => Eff es (MVar a)
33+newEmptyMVar = unsafeEff_ M.newEmptyMVar
34+
35+-- | Lifted 'M.newMVar'.
36+newMVar :: Concurrent :> es => a -> Eff es (MVar a)
37+newMVar = unsafeEff_ . M.newMVar
38+
39+-- | Lifted 'M.takeMVar'.
40+takeMVar :: Concurrent :> es => MVar a -> Eff es a
41+takeMVar = unsafeEff_ . M.takeMVar
42+
43+-- | Lifted 'M.putMVar'.
44+putMVar :: Concurrent :> es => MVar a -> a -> Eff es ()
45+putMVar var = unsafeEff_ . M.putMVar var
46+
47+-- | Lifted 'M.readMVar'.
48+readMVar :: Concurrent :> es => MVar a -> Eff es a
49+readMVar = unsafeEff_ . M.readMVar
50+
51+-- | Lifted 'M.swapMVar'.
52+swapMVar :: Concurrent :> es => MVar a -> a -> Eff es a
53+swapMVar var = unsafeEff_ . M.swapMVar var
54+
55+-- | Lifted 'M.tryTakeMVar'.
56+tryTakeMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
57+tryTakeMVar = unsafeEff_ . M.tryTakeMVar
58+
59+-- | Lifted 'M.tryPutMVar'.
60+tryPutMVar :: Concurrent :> es => MVar a -> a -> Eff es Bool
61+tryPutMVar var = unsafeEff_ . M.tryPutMVar var
62+
63+-- | Lifted 'M.isEmptyMVar'.
64+isEmptyMVar :: Concurrent :> es => MVar a -> Eff es Bool
65+isEmptyMVar = unsafeEff_ . M.isEmptyMVar
66+
67+-- | Lifted 'M.tryReadMVar'.
68+tryReadMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
69+tryReadMVar = unsafeEff_ . M.tryReadMVar
70+
71+-- | Lifted 'M.withMVar'.
72+withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
73+withMVar var f = unsafeEff $ \es -> M.withMVar var ((`unEff` es) . f)
74+
75+-- | Lifted 'M.withMVarMasked'.
76+withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
77+withMVarMasked var f = unsafeEff $ \es -> M.withMVarMasked var ((`unEff` es) . f)
78+
79+-- | Lifted 'M.modifyMVar_'.
80+modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
81+modifyMVar_ var f = unsafeEff $ \es -> M.modifyMVar_ var ((`unEff` es) . f)
82+
83+-- | Lifted 'M.modifyMVar'.
84+modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
85+modifyMVar var f = unsafeEff $ \es -> M.modifyMVar var ((`unEff` es) . f)
86+
87+-- | Lifted 'M.modifyMVarMasked_'.
88+modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
89+modifyMVarMasked_ var f = unsafeEff $ \es -> M.modifyMVarMasked_ var ((`unEff` es) . f)
90+
91+-- | Lifted 'M.modifyMVarMasked'.
92+modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
93+modifyMVarMasked var f = unsafeEff $ \es -> M.modifyMVarMasked var ((`unEff` es) . f)
94+
95+-- | Lifted 'M.mkWeakMVar'.
96+mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
97+mkWeakMVar var f = unsafeEff $ \es -> M.mkWeakMVar var ((`unEff` es) f)
effectful/src/Effectful/Concurrent/QSem.hsnew file+26
@@ -0,0 +1,26 @@
1+-- | Lifted "Control.Concurrent.QSem".
2+module Effectful.Concurrent.QSem
3+ ( QSem
4+ , newQSem
5+ , waitQSem
6+ , signalQSem
7+ ) where
8+
9+import Control.Concurrent.QSem (QSem)
10+import qualified Control.Concurrent.QSem as Q
11+
12+import Effectful.Concurrent.Internal
13+import Effectful.Internal.Effect
14+import Effectful.Internal.Monad
15+
16+-- | Lifted 'Q.newQSem'.
17+newQSem :: Concurrent :> es => Int -> Eff es QSem
18+newQSem = unsafeEff_ . Q.newQSem
19+
20+-- | Lifted 'Q.waitQSem'.
21+waitQSem :: Concurrent :> es => QSem -> Eff es ()
22+waitQSem = unsafeEff_ . Q.waitQSem
23+
24+-- | Lifted 'Q.signalQSem'.
25+signalQSem :: Concurrent :> es => QSem -> Eff es ()
26+signalQSem = unsafeEff_ . Q.signalQSem
effectful/src/Effectful/Concurrent/QSemN.hsnew file+26
@@ -0,0 +1,26 @@
1+-- | Lifted "Control.Concurrent.QSemN".
2+module Effectful.Concurrent.QSemN
3+ ( QSemN
4+ , newQSemN
5+ , waitQSemN
6+ , signalQSemN
7+ ) where
8+
9+import Control.Concurrent.QSemN (QSemN)
10+import qualified Control.Concurrent.QSemN as Q
11+
12+import Effectful.Concurrent.Internal
13+import Effectful.Internal.Effect
14+import Effectful.Internal.Monad
15+
16+-- | Lifted 'Q.newQSemN'.
17+newQSemN :: Concurrent :> es => Int -> Eff es QSemN
18+newQSemN = unsafeEff_ . Q.newQSemN
19+
20+-- | Lifted 'Q.waitQSemN'.
21+waitQSemN :: Concurrent :> es => QSemN -> Int -> Eff es ()
22+waitQSemN x = unsafeEff_ . Q.waitQSemN x
23+
24+-- | Lifted 'Q.signalQSemN'.
25+signalQSemN :: Concurrent :> es => QSemN -> Int -> Eff es ()
26+signalQSemN x = unsafeEff_ . Q.signalQSemN x
effectful/src/Effectful/Concurrent/STM.hsnew file+141
@@ -0,0 +1,141 @@
1+-- | Lifted version of "Control.Concurrent.STM".
2+module Effectful.Concurrent.STM
3+ ( -- * Core
4+ STM.STM
5+ , atomically
6+ , STM.retry
7+ , STM.orElse
8+ , STM.check
9+ , STM.throwSTM
10+ , STM.catchSTM
11+
12+ -- * TVar
13+ , STM.TVar
14+ , newTVarIO
15+ , readTVarIO
16+ , STM.newTVar
17+ , STM.readTVar
18+ , STM.writeTVar
19+ , STM.modifyTVar
20+ , STM.modifyTVar'
21+ , STM.swapTVar
22+ , registerDelay
23+ , mkWeakTVar
24+
25+ -- * TMVar
26+ , STM.TMVar
27+ , STM.newTMVar
28+ , STM.newEmptyTMVar
29+ , newTMVarIO
30+ , newEmptyTMVarIO
31+ , STM.takeTMVar
32+ , STM.putTMVar
33+ , STM.readTMVar
34+ , STM.tryReadTMVar
35+ , STM.swapTMVar
36+ , STM.tryTakeTMVar
37+ , STM.tryPutTMVar
38+ , STM.isEmptyTMVar
39+ , mkWeakTMVar
40+
41+ -- * TChan
42+ , STM.TChan
43+ , STM.newTChan
44+ , newTChanIO
45+ , STM.newBroadcastTChan
46+ , newBroadcastTChanIO
47+ , STM.dupTChan
48+ , STM.cloneTChan
49+ , STM.readTChan
50+ , STM.tryReadTChan
51+ , STM.peekTChan
52+ , STM.tryPeekTChan
53+ , STM.writeTChan
54+ , STM.unGetTChan
55+ , STM.isEmptyTChan
56+
57+ -- * TQueue
58+ , STM.TQueue
59+ , STM.newTQueue
60+ , newTQueueIO
61+ , STM.readTQueue
62+ , STM.tryReadTQueue
63+ , STM.peekTQueue
64+ , STM.tryPeekTQueue
65+ , STM.flushTQueue
66+ , STM.writeTQueue
67+ , STM.unGetTQueue
68+ , STM.isEmptyTQueue
69+
70+ -- * TBQueue
71+ , STM.TBQueue
72+ , STM.newTBQueue
73+ , newTBQueueIO
74+ , STM.readTBQueue
75+ , STM.tryReadTBQueue
76+ , STM.peekTBQueue
77+ , STM.tryPeekTBQueue
78+ , STM.flushTBQueue
79+ , STM.writeTBQueue
80+ , STM.unGetTBQueue
81+ , STM.lengthTBQueue
82+ , STM.isEmptyTBQueue
83+ , STM.isFullTBQueue
84+ ) where
85+
86+import Control.Concurrent.STM (STM, TVar, TMVar, TChan, TQueue, TBQueue)
87+import qualified Control.Concurrent.STM as STM
88+import System.Mem.Weak (Weak)
89+import GHC.Natural (Natural)
90+
91+import Effectful.Concurrent.Internal
92+import Effectful.Internal.Effect
93+import Effectful.Internal.Monad
94+
95+-- | Lifted version of 'STM.atomically'
96+atomically :: Concurrent :> es => STM a -> Eff es a
97+atomically = unsafeEff_ . STM.atomically
98+
99+-- | Lifted version of 'STM.newTVarIO'
100+newTVarIO :: Concurrent :> es => a -> Eff es (TVar a)
101+newTVarIO = unsafeEff_ . STM.newTVarIO
102+
103+-- | Lifted version of 'STM.readTVarIO'
104+readTVarIO :: Concurrent :> es => TVar a -> Eff es a
105+readTVarIO = unsafeEff_ . STM.readTVarIO
106+
107+-- | Lifted version of 'STM.registerDelay'
108+registerDelay :: Concurrent :> es => Int -> Eff es (TVar Bool)
109+registerDelay = unsafeEff_ . STM.registerDelay
110+
111+-- | Lifted version of 'STM.mkWeakTVar'
112+mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
113+mkWeakTVar var final = unsafeEff $ STM.mkWeakTVar var . unEff final
114+
115+-- | Lifted version of 'STM.newTMVarIO'
116+newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
117+newTMVarIO = unsafeEff_ . STM.newTMVarIO
118+
119+-- | Lifted version of 'STM.newEmptyTMVarIO'
120+newEmptyTMVarIO :: Concurrent :> es => Eff es (TMVar a)
121+newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO
122+
123+-- | Lifted version of 'STM.mkWeakTMVar'
124+mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
125+mkWeakTMVar var final = unsafeEff $ STM.mkWeakTMVar var . unEff final
126+
127+-- | Lifted version of 'STM.newTChanIO'
128+newTChanIO :: Concurrent :> es => Eff es (TChan a)
129+newTChanIO = unsafeEff_ STM.newTChanIO
130+
131+-- | Lifted version of 'STM.newBroadcastTChanIO'
132+newBroadcastTChanIO :: Concurrent :> es => Eff es (TChan a)
133+newBroadcastTChanIO = unsafeEff_ STM.newBroadcastTChanIO
134+
135+-- | Lifted version of 'STM.newTQueueIO'
136+newTQueueIO :: Concurrent :> es => Eff es (TQueue a)
137+newTQueueIO = unsafeEff_ STM.newTQueueIO
138+
139+-- | Lifted version of 'STM.newTBQueueIO'
140+newTBQueueIO :: Concurrent :> es => Natural -> Eff es (TBQueue a)
141+newTBQueueIO = unsafeEff_ . STM.newTBQueueIO