Skip to content

Commit 2bd3ab9

Browse files
authored
Merge pull request #120 from natefaubion/compat-updates
Compat updates
2 parents 46749af + 2c74812 commit 2bd3ab9

File tree

5 files changed

+46
-23
lines changed

5 files changed

+46
-23
lines changed

README.md

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -75,11 +75,9 @@ exports._ajaxGet = function (request) { // accepts a request
7575
});
7676

7777
// Return a canceler, which is just another Aff effect.
78-
return function (cancelError) {
79-
return function (cancelerError, cancelerSuccess) {
80-
req.cancel(); // cancel the request
81-
cancelerSuccess(); // invoke the success callback for the canceler
82-
};
78+
return function (cancelError, cancelerError, cancelerSuccess) {
79+
req.cancel(); // cancel the request
80+
cancelerSuccess(); // invoke the success callback for the canceler
8381
};
8482
};
8583
};

bower.json

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@
3232
"devDependencies": {
3333
"purescript-partial": "^1.2.0",
3434
"purescript-minibench": "^1.0.0",
35-
"purescript-assert": "^3.0.0"
35+
"purescript-assert": "^3.0.0",
36+
"purescript-js-timers": "^3.0.0"
3637
}
3738
}

src/Control/Monad/Aff.purs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ module Control.Monad.Aff
1919
, delay
2020
, never
2121
, finally
22-
, atomically
22+
, invincible
2323
, killFiber
2424
, joinFiber
2525
, cancelWith
@@ -41,7 +41,7 @@ import Control.Monad.Eff.Exception (Error, EXCEPTION, error)
4141
import Control.Monad.Eff.Exception (Error, error, message) as Exports
4242
import Control.Monad.Eff.Unsafe (unsafeCoerceEff, unsafePerformEff)
4343
import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError, catchError, try)
44-
import Control.Monad.Error.Class (try) as Exports
44+
import Control.Monad.Error.Class (try, throwError, catchError) as Exports
4545
import Control.Monad.Rec.Class (class MonadRec, Step(..))
4646
import Control.Parallel (parSequence_, parallel)
4747
import Control.Parallel.Class (class Parallel)
@@ -262,8 +262,8 @@ finally ∷ ∀ eff a. Aff eff Unit → Aff eff a → Aff eff a
262262
finally fin a = bracket (pure unit) (const fin) (const a)
263263

264264
-- | Runs an effect such that it cannot be killed.
265-
atomically eff a. Aff eff a Aff eff a
266-
atomically a = bracket a (const (pure unit)) pure
265+
invincible eff a. Aff eff a Aff eff a
266+
invincible a = bracket a (const (pure unit)) pure
267267

268268
-- | Attaches a custom `Canceler` to an action. If the computation is canceled,
269269
-- | then the custom `Canceler` will be run afterwards.

src/Control/Monad/Aff/Compat.purs

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -3,19 +3,22 @@
33
module Control.Monad.Aff.Compat
44
( EffFnAff(..)
55
, EffFnCanceler(..)
6+
, EffFnCb
67
, fromEffFnAff
8+
, module Control.Monad.Eff.Uncurried
79
) where
810

911
import Prelude
10-
import Control.Monad.Aff (Aff, Canceler(..), makeAff)
11-
import Control.Monad.Eff.Class (liftEff)
12+
import Control.Monad.Aff (Aff, Canceler(..), makeAff, nonCanceler)
1213
import Control.Monad.Eff.Exception (Error)
13-
import Control.Monad.Eff.Uncurried as Fn
14+
import Control.Monad.Eff.Uncurried (EffFn1, EffFn2, EffFn3, mkEffFn1, mkEffFn2, mkEffFn3, runEffFn1, runEffFn2, runEffFn3)
1415
import Data.Either (Either(..))
1516

16-
newtype EffFnAff eff a = EffFnAff (Fn.EffFn2 eff (Fn.EffFn1 eff Error Unit) (Fn.EffFn1 eff a Unit) (EffFnCanceler eff))
17+
type EffFnCb eff a = EffFn1 eff a Unit
1718

18-
newtype EffFnCanceler eff = EffFnCanceler (Fn.EffFn1 eff Error (EffFnAff eff Unit))
19+
newtype EffFnAff eff a = EffFnAff (EffFn2 eff (EffFnCb eff Error) (EffFnCb eff a) (EffFnCanceler eff))
20+
21+
newtype EffFnCanceler eff = EffFnCanceler (EffFn3 eff Error (EffFnCb eff Error) (EffFnCb eff Unit) Unit)
1922

2023
-- | Lift a FFI definition into an `Aff`. `EffFnAff` makes use of `EffFn` so
2124
-- | `Eff` thunks are unnecessary. A definition might follow this example:
@@ -29,11 +32,9 @@ newtype EffFnCanceler eff = EffFnCanceler (Fn.EffFn1 eff Error (EffFnAff eff Uni
2932
-- | onSuccess(res);
3033
-- | }
3134
-- | });
32-
-- | return function (cancelError) {
33-
-- | return function (onCancelerError, onCancelerSuccess) {
34-
-- | cancel();
35-
-- | onCancelerSuccess();
36-
-- | };
35+
-- | return function (cancelError, onCancelerError, onCancelerSuccess) {
36+
-- | cancel();
37+
-- | onCancelerSuccess();
3738
-- | };
3839
-- | };
3940
-- | ```
@@ -46,5 +47,7 @@ newtype EffFnCanceler eff = EffFnCanceler (Fn.EffFn1 eff Error (EffFnAff eff Uni
4647
-- | ````
4748
fromEffFnAff eff a. EffFnAff eff a Aff eff a
4849
fromEffFnAff (EffFnAff eff) = makeAff \k → do
49-
EffFnCanceler canceler ← Fn.runEffFn2 eff (Fn.mkEffFn1 (k <<< Left)) (Fn.mkEffFn1 (k <<< Right))
50-
pure $ Canceler \e → fromEffFnAff =<< liftEff (Fn.runEffFn1 canceler e)
50+
EffFnCanceler canceler ← runEffFn2 eff (mkEffFn1 (k <<< Left)) (mkEffFn1 (k <<< Right))
51+
pure $ Canceler \e → makeAff \k2 → do
52+
runEffFn3 canceler e (mkEffFn1 (k2 <<< Left)) (mkEffFn1 (k2 <<< Right))
53+
pure nonCanceler

test/Test/Main.purs

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ import Prelude
55
import Control.Alt ((<|>))
66
import Control.Monad.Aff (Aff, Canceler(..), runAff_, launchAff, makeAff, try, bracket, generalBracket, delay, forkAff, suspendAff, joinFiber, killFiber, never, supervise, Error, error, message)
77
import Control.Monad.Aff.AVar (AVAR, makeEmptyVar, takeVar, putVar)
8+
import Control.Monad.Aff.Compat as AC
89
import Control.Monad.Eff (Eff, runPure)
910
import Control.Monad.Eff.Class (class MonadEff, liftEff)
1011
import Control.Monad.Eff.Console (CONSOLE)
@@ -13,6 +14,7 @@ import Control.Monad.Eff.Exception (throwException, EXCEPTION)
1314
import Control.Monad.Eff.Ref (REF, Ref)
1415
import Control.Monad.Eff.Ref as Ref
1516
import Control.Monad.Eff.Ref.Unsafe (unsafeRunRef)
17+
import Control.Monad.Eff.Timer (TIMER, setTimeout, clearTimeout)
1618
import Control.Monad.Error.Class (throwError, catchError)
1719
import Control.Parallel (parallel, sequential, parTraverse_)
1820
import Data.Array as Array
@@ -25,7 +27,7 @@ import Data.Time.Duration (Milliseconds(..))
2527
import Data.Traversable (traverse)
2628
import Test.Assert (assert', ASSERT)
2729

28-
type TestEffects eff = (assert ASSERT, console CONSOLE, ref REF, exception EXCEPTION, avar AVAR | eff)
30+
type TestEffects eff = (assert ASSERT, console CONSOLE, ref REF, exception EXCEPTION, avar AVAR, timer TIMER | eff)
2931
type TestEff eff = Eff (TestEffects eff)
3032
type TestAff eff = Aff (TestEffects eff)
3133

@@ -561,6 +563,24 @@ test_avar_order = assert "avar/order" do
561563
joinFiber f1
562564
eq "takenfoo" <$> readRef ref
563565

566+
test_efffn eff. TestAff eff Unit
567+
test_efffn = assert "efffn" do
568+
ref ← newRef ""
569+
let
570+
jsDelay ms = AC.fromEffFnAff $ AC.EffFnAff $ AC.mkEffFn2 \ke kc → do
571+
tid ← setTimeout ms (AC.runEffFn1 kc unit)
572+
pure $ AC.EffFnCanceler $ AC.mkEffFn3 \e cke ckc → do
573+
clearTimeout tid
574+
AC.runEffFn1 ckc unit
575+
action = do
576+
jsDelay 10
577+
modifyRef ref (_ <> "done")
578+
f1 ← forkAff action
579+
f2 ← forkAff action
580+
killFiber (error "Nope.") f2
581+
delay (Milliseconds 20.0)
582+
eq "done" <$> readRef ref
583+
564584
test_parallel_stack eff. TestAff eff Unit
565585
test_parallel_stack = assert "parallel/stack" do
566586
ref ← newRef 0
@@ -609,6 +629,7 @@ main = do
609629
test_parallel_mixed
610630
test_kill_parallel_alt
611631
test_avar_order
632+
test_efffn
612633
test_fiber_map
613634
test_fiber_apply
614635
-- Turn on if we decide to schedule forks

0 commit comments

Comments
 (0)