Revert fancy rows in instances. Simplify liftEff/makeAff wrappers.

Author: natefaubion

src/Control/Monad/Aff.purs

@@ -1,24 +1,29 @@
 module Control.Monad.Aff
   ( module Internal
+  , liftEff'
   , forkAff
   , runAff
   , killThread
   , joinThread
   ) where
 
 import Prelude
-import Control.Monad.Aff.Internal (ASYNC, Aff, AffModality, Thread(..), attempt, launchAff, unsafeLaunchAff, unsafeLiftEff)
-import Control.Monad.Aff.Internal (Aff, AffModality, ParAff, Thread, Canceler(..), ASYNC, attempt, bracket, delay, launchAff, makeAff, nonCanceler) as Internal
+import Control.Monad.Aff.Internal (ASYNC, Aff, Thread(..), attempt, launchAff, unsafeLaunchAff)
+import Control.Monad.Aff.Internal (Aff, ParAff, Thread, Canceler(..), ASYNC, attempt, bracket, delay, launchAff, makeAff, nonCanceler) as Internal
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Exception (Error)
+import Control.Monad.Eff.Exception (Error, EXCEPTION)
+import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
 import Data.Either (Either)
 
-runAff ∷ ∀ eff a. (Either Error a → Eff (AffModality eff) Unit) → Aff eff a → Eff (async ∷ ASYNC | eff) Unit
+liftEff' ∷ ∀ eff a. Eff (exception ∷ EXCEPTION | eff) a → Aff eff a
+liftEff' = liftEff <<< unsafeCoerceEff
+
+runAff ∷ ∀ eff a. (Either Error a → Eff eff Unit) → Aff eff a → Eff (async ∷ ASYNC | eff) Unit
 runAff k aff = void $ launchAff $ liftEff <<< k =<< attempt aff
 
 forkAff ∷ ∀ eff a. Aff eff a → Aff eff (Thread eff a)
-forkAff = unsafeLiftEff <<< unsafeLaunchAff
+forkAff = liftEff <<< unsafeLaunchAff
 
 killThread ∷ ∀ eff a. Error → Thread eff a → Aff eff Unit
 killThread e (Thread t) = t.kill e

src/Control/Monad/Aff/Class.purs

@@ -2,10 +2,9 @@ module Control.Monad.Aff.Class where
 
 import Prelude
 
-import Control.Monad.Aff (Aff, ASYNC)
+import Control.Monad.Aff (Aff)
 import Control.Monad.Cont.Trans (ContT)
 import Control.Monad.Eff.Class (class MonadEff)
-import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Except.Trans (ExceptT)
 import Control.Monad.List.Trans (ListT)
 import Control.Monad.Maybe.Trans (MaybeT)
@@ -17,8 +16,8 @@ import Control.Monad.Writer.Trans (WriterT)
 
 import Data.Monoid (class Monoid)
 
-class MonadEff (exception ∷ EXCEPTION, async ∷ ASYNC | eff) m ⇐ MonadAff eff m | m → eff where
-  liftAff :: forall a. Aff eff a -> m a
+class MonadEff eff m ⇐ MonadAff eff m | m → eff where
+  liftAff ∷ ∀ a. Aff eff a → m a
 
 instance monadAffAff ∷ MonadAff e (Aff e) where
   liftAff = id

src/Control/Monad/Aff/Internal.js

@@ -66,11 +66,11 @@ exports._bind = function (aff) {
   };
 };
 
-exports.unsafeLiftEff = function (eff) {
+exports._liftEff = function (eff) {
   return new Aff(SYNC, eff);
 };
 
-exports.unsafeMakeAff = function (k) {
+exports.makeAff = function (k) {
   return new Aff(ASYNC, k);
 };
 
@@ -86,19 +86,6 @@ exports.bracket = function (acquire) {
   };
 };
 
-exports._makeAff = function (left, right, aff) {
-  return new Aff(ASYNC, function (k) {
-    return function () {
-      try {
-        return aff(k)();
-      } catch (error) {
-        k(left(error))();
-        return nonCanceler;
-      }
-    };
-  });
-};
-
 exports._delay = function () {
   var setDelay = function (n, k) {
     if (n === 0 && typeof setImmediate !== "undefined") {
@@ -219,7 +206,7 @@ exports._launchAff = function (isLeft, fromLeft, fromRight, left, right, aff) {
 
           case SYNC:
             status = BLOCKED;
-            result = runSync(step._1);
+            result = runSync(left, right, step._1);
             if (isLeft(result)) {
               status = RETURN;
               fail   = result;
@@ -234,7 +221,7 @@ exports._launchAff = function (isLeft, fromLeft, fromRight, left, right, aff) {
 
           case ASYNC:
             status   = BLOCKED;
-            canceler = step._1(function (result) {
+            canceler = runAsync(left, step._1, function (result) {
               return function () {
                 if (runTick !== localRunTick) {
                   return;
@@ -260,7 +247,7 @@ exports._launchAff = function (isLeft, fromLeft, fromRight, left, right, aff) {
                   localRunTick = ++runTick;
                 }
               };
-            })();
+            });
             // If the callback was resolved synchronously, the status will have
             // switched to CONTINUE, and we should not move on to PENDING.
             if (status === BLOCKED) {
@@ -395,14 +382,6 @@ exports._launchAff = function (isLeft, fromLeft, fromRight, left, right, aff) {
       }
     }
 
-    function runSync (eff) {
-      try {
-        return right(eff());
-      } catch (error) {
-        return left(error)
-      }
-    }
-
     function addJoinCallback (cb) {
       var jid    = joinId++;
       joins[jid] = cb;
@@ -492,3 +471,20 @@ function runJoin (result, cb) {
     }, 0)
   }
 }
+
+function runSync (left, right, eff) {
+  try {
+    return right(eff());
+  } catch (error) {
+    return left(error)
+  }
+}
+
+function runAsync (left, eff, k) {
+  try {
+    return eff(k)();
+  } catch (error) {
+    k(left(error))();
+    return nonCanceler;
+  }
+}

src/Control/Monad/Aff/Internal.purs

@@ -1,6 +1,5 @@
 module Control.Monad.Aff.Internal
   ( Aff
-  , AffModality
   , ParAff(..)
   , Thread(..)
   , Canceler(..)
@@ -12,17 +11,15 @@ module Control.Monad.Aff.Internal
   , bracket
   , delay
   , unsafeLaunchAff
-  , unsafeLiftEff
-  , unsafeMakeAff
   ) where
 
 import Prelude
 import Control.Alt (class Alt)
 import Control.Alternative (class Alternative)
 import Control.Apply (lift2)
 import Control.Monad.Eff (Eff, kind Effect)
-import Control.Monad.Eff.Class (class MonadEff)
-import Control.Monad.Eff.Exception (EXCEPTION, Error, error)
+import Control.Monad.Eff.Class (class MonadEff, liftEff)
+import Control.Monad.Eff.Exception (Error, error)
 import Control.Monad.Eff.Ref (newRef, readRef, writeRef)
 import Control.Monad.Eff.Ref.Unsafe (unsafeRunRef)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError)
@@ -39,19 +36,12 @@ import Data.Monoid (class Monoid, mempty)
 import Data.Newtype (class Newtype)
 import Data.Time.Duration (Milliseconds(..))
 import Partial.Unsafe (unsafeCrashWith)
-import Type.Row.Effect.Equality (class EffectRowEquals)
 import Unsafe.Coerce (unsafeCoerce)
 
 foreign import data Aff ∷ # Effect → Type → Type
 
 foreign import data ASYNC ∷ Effect
 
-type AffModality eff =
-  ( exception ∷ EXCEPTION
-  , async ∷ ASYNC
-  | eff
-  )
-
 instance functorAff ∷ Functor (Aff eff) where map = _map
 instance applyAff ∷ Apply (Aff eff) where apply = ap
 instance applicativeAff ∷ Applicative (Aff eff) where pure = _pure
@@ -99,27 +89,24 @@ instance monadErrorAff ∷ MonadError Error (Aff eff) where
       Left err → k err
       Right r  → pure r
 
-instance monadEffAff ∷ EffectRowEquals eff1 (exception ∷ EXCEPTION, async ∷ ASYNC | eff2) ⇒ MonadEff eff1 (Aff eff2) where
-  liftEff eff = unsafeLiftEff (coerceEff eff)
-    where
-    coerceEff ∷ Eff eff1 ~> Eff eff2
-    coerceEff = unsafeCoerce
+instance monadEffAff ∷ MonadEff eff (Aff eff) where
+  liftEff = _liftEff
 
 newtype ParAff eff a = ParAff (Aff eff a)
 
 derive instance newtypeParAff ∷ Newtype (ParAff eff a) _
 derive newtype instance functorParAff ∷ Functor (ParAff eff)
 
 instance applyParAff ∷ Apply (ParAff eff) where
-  apply (ParAff ff) (ParAff fa) = ParAff (unsafeMakeAff go)
+  apply (ParAff ff) (ParAff fa) = ParAff (makeAff go)
     where
     go k = do
       Thread t1 ← unsafeLaunchAff ff
       Thread t2 ← unsafeLaunchAff fa
       Thread t3 ← unsafeLaunchAff do
         f ← attempt t1.join
         a ← attempt t2.join
-        unsafeLiftEff (k (f <*> a))
+        liftEff (k (f <*> a))
       pure $ Canceler \err →
         parSequence_
           [ t3.kill err
@@ -137,7 +124,7 @@ instance monoidParAff ∷ Monoid a ⇒ Monoid (ParAff eff a) where
   mempty = pure mempty
 
 instance altParAff ∷ Alt (ParAff eff) where
-  alt (ParAff a1) (ParAff a2) = ParAff (unsafeMakeAff go)
+  alt (ParAff a1) (ParAff a2) = ParAff (makeAff go)
     where
     go k = do
       ref ← unsafeRunRef $ newRef Nothing
@@ -149,11 +136,11 @@ instance altParAff ∷ Alt (ParAff eff) where
           error "Alt ParAff: early exit"
 
         runK t r = do
-          res ← unsafeLiftEff $ unsafeRunRef $ readRef ref
+          res ← liftEff $ unsafeRunRef $ readRef ref
           case res, r of
-            Nothing, Left _ → unsafeLiftEff $ unsafeRunRef $ writeRef ref (Just r)
-            Nothing, Right _ → t.kill earlyError *> unsafeLiftEff (k r)
-            Just r', _ → t.kill earlyError *> unsafeLiftEff (k r')
+            Nothing, Left _ → liftEff $ unsafeRunRef $ writeRef ref (Just r)
+            Nothing, Right _ → t.kill earlyError *> liftEff (k r)
+            Just r', _ → t.kill earlyError *> liftEff (k r')
 
       Thread t3 ← unsafeLaunchAff $ runK t2 =<< attempt t1.join
       Thread t4 ← unsafeLaunchAff $ runK t1 =<< attempt t2.join
@@ -203,9 +190,6 @@ launchAff aff = Fn.runFn6 _launchAff isLeft unsafeFromLeft unsafeFromRight Left
 unsafeLaunchAff ∷ ∀ eff a. Aff eff a → Eff eff (Thread eff a)
 unsafeLaunchAff = unsafeCoerce launchAff
 
-makeAff ∷ ∀ eff a. ((Either Error a → Eff (AffModality eff) Unit) → Eff (AffModality eff) (Canceler eff)) → Aff eff a
-makeAff k = Fn.runFn3 _makeAff Left Right k
-
 delay ∷ ∀ eff. Milliseconds → Aff eff Unit
 delay (Milliseconds n) = Fn.runFn2 _delay Right n
 
@@ -214,18 +198,10 @@ foreign import _throwError ∷ ∀ eff a. Error → Aff eff a
 foreign import _map ∷ ∀ eff a b. (a → b) → Aff eff a → Aff eff b
 foreign import _bind ∷ ∀ eff a b. Aff eff a → (a → Aff eff b) → Aff eff b
 foreign import _delay ∷ ∀ a eff. Fn.Fn2 (Unit → Either a Unit) Number (Aff eff Unit)
+foreign import _liftEff ∷ ∀ eff a. Eff eff a → Aff eff a
 foreign import attempt ∷ ∀ eff a. Aff eff a → Aff eff (Either Error a)
 foreign import bracket ∷ ∀ eff a b. Aff eff a → (a → Aff eff Unit) → (a → Aff eff b) → Aff eff b
-foreign import unsafeLiftEff ∷ ∀ eff a. Eff eff a → Aff eff a
-foreign import unsafeMakeAff ∷ ∀ eff a. ((Either Error a → Eff eff Unit) → Eff eff (Canceler eff)) → Aff eff a
-
-foreign import _makeAff
-  ∷ ∀ eff a
-  . Fn.Fn3
-      (Error → Either Error a)
-      (a → Either Error a)
-      ((Either Error a → Eff (AffModality eff) Unit) → Eff (AffModality eff) (Canceler eff))
-      (Aff eff a)
+foreign import makeAff ∷ ∀ eff a. ((Either Error a → Eff eff Unit) → Eff eff (Canceler eff)) → Aff eff a
 
 foreign import _launchAff
   ∷ ∀ eff a

src/Control/Monad/Aff/Unsafe.purs

@@ -1,10 +1,10 @@
 module Control.Monad.Aff.Unsafe
   ( unsafeCoerceAff
-  , module Internal
+  , module Control.Monad.Aff.Internal
   ) where
 
 import Control.Monad.Aff (Aff)
-import Control.Monad.Aff.Internal (unsafeLaunchAff, unsafeLiftEff, unsafeMakeAff) as Internal
+import Control.Monad.Aff.Internal (unsafeLaunchAff)
 import Unsafe.Coerce (unsafeCoerce)
 
 unsafeCoerceAff ∷ ∀ eff1 eff2 a. Aff eff1 a -> Aff eff2 a

test/Test/Bench.purs

@@ -59,5 +59,5 @@ main = do
   bench \_ → runPure $ unsafeCoerceEff $ void $ Aff.launchAff $ loop2 10000
 
   Console.log "\nAff fib:"
-  bench \_ → runPure $ unsafeCoerceEff $ void $ Aff.launchAff $ fib1 100
+  bench \_ → runPure $ unsafeCoerceEff $ void $ Aff.launchAff $ fib1 20
 

test/Test/Main.purs

@@ -18,7 +18,7 @@ import Data.Traversable (traverse)
 import Data.Time.Duration (Milliseconds(..))
 import Test.Assert (assert', ASSERT)
 
-type TestEffects eff = (assert ∷ ASSERT, console ∷ CONSOLE, ref ∷ REF | eff)
+type TestEffects eff = (assert ∷ ASSERT, console ∷ CONSOLE, ref ∷ REF, exception ∷ EXCEPTION | eff)
 type TestEff eff = Eff (TestEffects (async ∷ ASYNC | eff))
 type TestAff eff = Aff (TestEffects eff)
 
@@ -34,10 +34,10 @@ writeRef r = liftEff <<< Ref.writeRef r
 modifyRef ∷ ∀ m eff a. MonadEff (ref ∷ REF | eff) m ⇒ Ref a → (a → a) → m Unit
 modifyRef r = liftEff <<< Ref.modifyRef r
 
-assertEff ∷ ∀ eff. String → Either Error Boolean → TestEff (exception ∷ EXCEPTION | eff) Unit
+assertEff ∷ ∀ eff. String → Either Error Boolean → Eff (TestEffects eff) Unit
 assertEff s = case _ of
   Left err → do
-    Console.error ("[Error] " <> s)
+    Console.log ("[Error] " <> s)
     throwException err
   Right r → do
     assert' s r