/
Class.purs
124 lines (102 loc) · 4.27 KB
/
Class.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
module Control.Parallel.Class
( class Parallel
, parallel
, sequential
, ParCont(..)
) where
import Prelude
import Control.Alt (class Alt)
import Control.Alternative (class Alternative)
import Control.Monad.Cont.Trans (ContT(..), runContT)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Eff.Ref (REF, writeRef, readRef, newRef)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Except.Trans (ExceptT(..))
import Control.Monad.Maybe.Trans (MaybeT(..))
import Control.Monad.Reader.Trans (mapReaderT, ReaderT)
import Control.Monad.Writer.Trans (mapWriterT, WriterT)
import Control.Parallel.Class (class Parallel, parallel, sequential)
import Control.Plus (class Plus)
import Data.Either (Either)
import Data.Functor.Compose (Compose(..))
import Data.Maybe (Maybe(..))
import Data.Monoid (class Monoid)
import Data.Newtype (class Newtype)
-- | The `Parallel` class abstracts over monads which support
-- | parallel composition via some related `Applicative`.
class (Monad m, Applicative f) <= Parallel f m | m -> f, f -> m where
parallel :: m ~> f
sequential :: f ~> m
instance monadParExceptT :: Parallel f m => Parallel (Compose f (Either e)) (ExceptT e m) where
parallel (ExceptT ma) = Compose (parallel ma)
sequential (Compose fa) = ExceptT (sequential fa)
instance monadParReaderT :: Parallel f m => Parallel (ReaderT e f) (ReaderT e m) where
parallel = mapReaderT parallel
sequential = mapReaderT sequential
instance monadParWriterT :: (Monoid w, Parallel f m) => Parallel (WriterT w f) (WriterT w m) where
parallel = mapWriterT parallel
sequential = mapWriterT sequential
instance monadParMaybeT :: Parallel f m => Parallel (Compose f Maybe) (MaybeT m) where
parallel (MaybeT ma) = Compose (parallel ma)
sequential (Compose fa) = MaybeT (sequential fa)
-- | The `ParCont` type constructor provides an `Applicative` instance
-- | based on `ContT Unit m`, which waits for multiple continuations to be
-- | resumed simultaneously.
-- |
-- | ParCont sections of code can be embedded in sequential code by using
-- | the `parallel` and `sequential` functions:
-- |
-- | ```purescript
-- | loadModel :: ContT Unit (Eff (ajax :: AJAX)) Model
-- | loadModel = do
-- | token <- authenticate
-- | sequential $
-- | Model <$> parallel (get "/products/popular/" token)
-- | <*> parallel (get "/categories/all" token)
-- | ```
newtype ParCont m a = ParCont (ContT Unit m a)
derive instance newtypeParCont :: Newtype (ParCont m a) _
instance functorParCont :: MonadEff eff m => Functor (ParCont m) where
map f = parallel <<< map f <<< sequential
instance applyParCont :: MonadEff eff m => Apply (ParCont m) where
apply (ParCont ca) (ParCont cb) = ParCont $ ContT \k -> do
ra <- liftEff $ unsafeWithRef (newRef Nothing)
rb <- liftEff $ unsafeWithRef (newRef Nothing)
runContT ca \a -> do
mb <- liftEff $ unsafeWithRef (readRef rb)
case mb of
Nothing -> liftEff $ unsafeWithRef (writeRef ra (Just a))
Just b -> k (a b)
runContT cb \b -> do
ma <- liftEff $ unsafeWithRef (readRef ra)
case ma of
Nothing -> liftEff $ unsafeWithRef (writeRef rb (Just b))
Just a -> k (a b)
instance applicativeParCont :: MonadEff eff m => Applicative (ParCont m) where
pure = parallel <<< pure
instance altParCont :: MonadEff eff m => Alt (ParCont m) where
alt (ParCont c1) (ParCont c2) = ParCont $ ContT \k -> do
done <- liftEff $ unsafeWithRef (newRef false)
runContT c1 \a -> do
b <- liftEff $ unsafeWithRef (readRef done)
if b
then pure unit
else do
liftEff $ unsafeWithRef (writeRef done true)
k a
runContT c2 \a -> do
b <- liftEff $ unsafeWithRef (readRef done)
if b
then pure unit
else do
liftEff $ unsafeWithRef (writeRef done true)
k a
instance plusParCont :: MonadEff eff m => Plus (ParCont m) where
empty = ParCont $ ContT \_ -> pure unit
instance alternativeParCont :: MonadEff eff m => Alternative (ParCont m)
instance monadParParCont :: MonadEff eff m => Parallel (ParCont m) (ContT Unit m) where
parallel = ParCont
sequential (ParCont ma) = ma
unsafeWithRef :: forall eff a. Eff (ref :: REF | eff) a -> Eff eff a
unsafeWithRef = unsafeCoerceEff