Skip to content

Commit d7a782d

Browse files
committed
Merge pull request #28 from slamdata/monadcont
Add MonadCont instance
2 parents f82e750 + 9ba5ddf commit d7a782d

File tree

3 files changed

+15
-2
lines changed

3 files changed

+15
-2
lines changed

docs/Control.Monad.Aff.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ instance plusAff :: Plus (Aff e)
2727
instance alternativeAff :: Alternative (Aff e)
2828
instance monadPlusAff :: MonadPlus (Aff e)
2929
instance monadRecAff :: MonadRec (Aff e)
30+
instance monadContAff :: MonadCont (Aff e)
3031
```
3132

3233
#### `PureAff`

src/Control/Monad/Aff.purs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ module Control.Monad.Aff
2323

2424
import Control.Alt(Alt)
2525
import Control.Alternative(Alternative)
26+
import Control.Monad.Cont.Class(MonadCont)
2627
import Control.Monad.Eff(Eff())
2728
import Control.Monad.Eff.Class(MonadEff, liftEff)
2829
import Control.Monad.Eff.Exception(Error(), EXCEPTION(), catchException, error)
@@ -179,6 +180,8 @@ module Control.Monad.Aff
179180
| otherwise -> later (tailRecM f a')
180181
Right b -> pure b
181182

183+
instance monadContAff :: MonadCont (Aff e) where
184+
callCC f = makeAff (\eb cb -> runAff eb cb (f \a -> makeAff (\_ _ -> cb a)))
182185

183186
instance semigroupCanceler :: Semigroup (Canceler e) where
184187
append (Canceler f1) (Canceler f2) = Canceler (\e -> (||) <$> f1 e <*> f2 e)

test/Test/Main.purs

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@ module Test.Main where
22

33
import Prelude
44

5-
import Control.Monad.Aff (Aff(), runAff)
5+
import Control.Monad.Aff (Aff(), runAff, later')
6+
import Control.Monad.Cont.Class (callCC)
67
import Control.Monad.Eff (Eff())
78
import Control.Monad.Eff.Class (liftEff)
89
import Control.Monad.Eff.Console (CONSOLE(), log, print)
@@ -19,5 +20,13 @@ loop n = tailRecM go n
1920
return (Right unit)
2021
go n = return (Left (n - 1))
2122

23+
delay :: forall eff. Int -> Aff eff Unit
24+
delay n = callCC \cont ->
25+
later' n (cont unit)
26+
2227
main :: Eff (console :: CONSOLE, err :: EXCEPTION) Unit
23-
main = runAff throwException (const (pure unit)) $ loop 1000000
28+
main = runAff throwException (const (pure unit)) $ do
29+
liftEff $ log "pre-delay"
30+
delay 1000
31+
liftEff $ log "post-delay"
32+
loop 1000000

0 commit comments

Comments
 (0)