|
1 | | -module Control.Parallel.Class |
2 | | - ( class Parallel |
3 | | - , parallel |
4 | | - , sequential |
5 | | - , ParCont(..) |
6 | | - ) where |
| 1 | +module Control.Parallel.Class where |
7 | 2 |
|
8 | 3 | import Prelude |
9 | 4 |
|
10 | 5 | import Control.Alt (class Alt) |
11 | 6 | import Control.Alternative (class Alternative) |
12 | 7 | import Control.Monad.Cont.Trans (ContT(..), runContT) |
13 | | -import Control.Monad.Eff (Eff) |
14 | | -import Control.Monad.Eff.Class (class MonadEff, liftEff) |
15 | | -import Control.Monad.Eff.Ref (REF, writeRef, readRef, newRef) |
16 | | -import Control.Monad.Eff.Unsafe (unsafeCoerceEff) |
17 | 8 | import Control.Monad.Except.Trans (ExceptT(..)) |
18 | 9 | import Control.Monad.Maybe.Trans (MaybeT(..)) |
19 | 10 | import Control.Monad.Reader.Trans (mapReaderT, ReaderT) |
20 | 11 | import Control.Monad.Writer.Trans (mapWriterT, WriterT) |
21 | 12 | import Control.Plus (class Plus) |
22 | | - |
23 | 13 | import Data.Either (Either) |
24 | 14 | import Data.Functor.Compose (Compose(..)) |
25 | 15 | import Data.Maybe (Maybe(..)) |
26 | | -import Data.Monoid (class Monoid) |
27 | 16 | import Data.Newtype (class Newtype) |
| 17 | +import Effect.Class (class MonadEffect, liftEffect) |
| 18 | +import Effect.Ref as Ref |
28 | 19 |
|
29 | 20 | -- | The `Parallel` class abstracts over monads which support |
30 | 21 | -- | parallel composition via some related `Applicative`. |
31 | 22 | class (Monad m, Applicative f) <= Parallel f m | m -> f, f -> m where |
32 | | - parallel :: m ~> f |
| 23 | + parallel :: m ~> f |
33 | 24 | sequential :: f ~> m |
34 | 25 |
|
35 | 26 | instance monadParExceptT :: Parallel f m => Parallel (Compose f (Either e)) (ExceptT e m) where |
@@ -67,57 +58,54 @@ newtype ParCont m a = ParCont (ContT Unit m a) |
67 | 58 |
|
68 | 59 | derive instance newtypeParCont :: Newtype (ParCont m a) _ |
69 | 60 |
|
70 | | -instance functorParCont :: MonadEff eff m => Functor (ParCont m) where |
| 61 | +instance functorParCont :: MonadEffect m => Functor (ParCont m) where |
71 | 62 | map f = parallel <<< map f <<< sequential |
72 | 63 |
|
73 | | -instance applyParCont :: MonadEff eff m => Apply (ParCont m) where |
| 64 | +instance applyParCont :: MonadEffect m => Apply (ParCont m) where |
74 | 65 | apply (ParCont ca) (ParCont cb) = ParCont $ ContT \k -> do |
75 | | - ra <- liftEff $ unsafeWithRef (newRef Nothing) |
76 | | - rb <- liftEff $ unsafeWithRef (newRef Nothing) |
| 66 | + ra <- liftEffect (Ref.new Nothing) |
| 67 | + rb <- liftEffect (Ref.new Nothing) |
77 | 68 |
|
78 | 69 | runContT ca \a -> do |
79 | | - mb <- liftEff $ unsafeWithRef (readRef rb) |
| 70 | + mb <- liftEffect (Ref.read rb) |
80 | 71 | case mb of |
81 | | - Nothing -> liftEff $ unsafeWithRef (writeRef ra (Just a)) |
| 72 | + Nothing -> liftEffect (Ref.write (Just a) ra) |
82 | 73 | Just b -> k (a b) |
83 | 74 |
|
84 | 75 | runContT cb \b -> do |
85 | | - ma <- liftEff $ unsafeWithRef (readRef ra) |
| 76 | + ma <- liftEffect (Ref.read ra) |
86 | 77 | case ma of |
87 | | - Nothing -> liftEff $ unsafeWithRef (writeRef rb (Just b)) |
| 78 | + Nothing -> liftEffect (Ref.write (Just b) rb) |
88 | 79 | Just a -> k (a b) |
89 | 80 |
|
90 | | -instance applicativeParCont :: MonadEff eff m => Applicative (ParCont m) where |
| 81 | +instance applicativeParCont :: MonadEffect m => Applicative (ParCont m) where |
91 | 82 | pure = parallel <<< pure |
92 | 83 |
|
93 | | -instance altParCont :: MonadEff eff m => Alt (ParCont m) where |
| 84 | +instance altParCont :: MonadEffect m => Alt (ParCont m) where |
94 | 85 | alt (ParCont c1) (ParCont c2) = ParCont $ ContT \k -> do |
95 | | - done <- liftEff $ unsafeWithRef (newRef false) |
| 86 | + done <- liftEffect (Ref.new false) |
96 | 87 |
|
97 | 88 | runContT c1 \a -> do |
98 | | - b <- liftEff $ unsafeWithRef (readRef done) |
| 89 | + b <- liftEffect (Ref.read done) |
99 | 90 | if b |
100 | 91 | then pure unit |
101 | 92 | else do |
102 | | - liftEff $ unsafeWithRef (writeRef done true) |
| 93 | + liftEffect (Ref.write true done) |
103 | 94 | k a |
104 | 95 |
|
105 | 96 | runContT c2 \a -> do |
106 | | - b <- liftEff $ unsafeWithRef (readRef done) |
| 97 | + b <- liftEffect (Ref.read done) |
107 | 98 | if b |
108 | 99 | then pure unit |
109 | 100 | else do |
110 | | - liftEff $ unsafeWithRef (writeRef done true) |
| 101 | + liftEffect (Ref.write true done) |
111 | 102 | k a |
112 | 103 |
|
113 | | -instance plusParCont :: MonadEff eff m => Plus (ParCont m) where |
| 104 | +instance plusParCont :: MonadEffect m => Plus (ParCont m) where |
114 | 105 | empty = ParCont $ ContT \_ -> pure unit |
115 | 106 |
|
116 | | -instance alternativeParCont :: MonadEff eff m => Alternative (ParCont m) |
| 107 | +instance alternativeParCont :: MonadEffect m => Alternative (ParCont m) |
117 | 108 |
|
118 | | -instance monadParParCont :: MonadEff eff m => Parallel (ParCont m) (ContT Unit m) where |
| 109 | +instance monadParParCont :: MonadEffect m => Parallel (ParCont m) (ContT Unit m) where |
119 | 110 | parallel = ParCont |
120 | 111 | sequential (ParCont ma) = ma |
121 | | - |
122 | | -unsafeWithRef :: forall eff a. Eff (ref :: REF | eff) a -> Eff eff a |
123 | | -unsafeWithRef = unsafeCoerceEff |
0 commit comments