Updates dependencies for PureScript 0.10

bower.json

@@ -17,12 +17,12 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-console": "^1.0.0",
-    "purescript-exceptions": "^1.0.0",
-    "purescript-functions": "^1.0.0",
-    "purescript-parallel": "^1.0.0",
-    "purescript-transformers": "^1.0.0",
-    "purescript-unsafe-coerce": "^1.0.0"
+    "purescript-console": "^2.0.0",
+    "purescript-exceptions": "^2.0.0",
+    "purescript-functions": "^2.0.0",
+    "purescript-parallel": "^2.0.0",
+    "purescript-transformers": "^2.0.1",
+    "purescript-unsafe-coerce": "^2.0.0"
   },
   "devDependencies": {
     "purescript-partial": "^1.1.2"

package.json

@@ -7,10 +7,10 @@
   },
   "devDependencies": {
     "jscs": "^3.0.7",
-    "jshint": "^2.9.3",
+    "jshint": "^2.9.4",
     "pulp": "^9.0.1",
     "purescript-psa": "^0.3.9",
-    "purescript": "^0.9.3",
+    "purescript": "^0.10.1",
     "rimraf": "^2.5.4"
   }
 }

src/Control/Monad/Aff.purs

@@ -1,5 +1,5 @@
 module Control.Monad.Aff
-  ( Aff()
+  ( Aff
   , Canceler(..)
   , PureAff(..)
   , apathize
@@ -17,8 +17,8 @@ module Control.Monad.Aff
   , makeAff'
   , nonCanceler
   , runAff
-  )
-  where
+  , ParAff(..)
+  ) where
 
 import Prelude
 
@@ -30,15 +30,16 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (class MonadEff)
 import Control.Monad.Eff.Exception (Error, EXCEPTION, throwException, error)
 import Control.Monad.Error.Class (class MonadError, throwError)
-import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.Rec.Class (class MonadRec, Step(..))
 import Control.MonadPlus (class MonadZero, class MonadPlus)
-import Control.Parallel.Class (class MonadRace, class MonadPar)
-import Control.Plus (class Plus)
+import Control.Parallel (class Parallel)
+import Control.Plus (class Plus, empty)
 
-import Data.Either (Either(..), either, isLeft)
+import Data.Either (Either(..), either)
 import Data.Foldable (class Foldable, foldl)
 import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
 import Data.Monoid (class Monoid, mempty)
+import Data.Newtype (class Newtype)
 
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -202,7 +203,10 @@ instance monadZero :: MonadZero (Aff e)
 instance monadPlusAff :: MonadPlus (Aff e)
 
 instance monadRecAff :: MonadRec (Aff e) where
-  tailRecM f a = runFn3 _tailRecM isLeft f a
+  tailRecM f a = runFn3 _tailRecM isLoop f a
+    where
+    isLoop (Loop _) = true
+    isLoop _ = false
 
 instance monadContAff :: MonadCont (Aff e) where
   callCC f = makeAff (\eb cb -> void $ runAff eb cb (f \a -> makeAff (\_ _ -> cb a)))
@@ -213,20 +217,34 @@ instance semigroupCanceler :: Semigroup (Canceler e) where
 instance monoidCanceler :: Monoid (Canceler e) where
   mempty = Canceler (const (pure true))
 
-instance monadParAff :: MonadPar (Aff e) where
-  par f ma mb = do
+newtype ParAff e a = ParAff (Aff e a)
+
+derive instance newtypeParAff :: Newtype (ParAff e a) _
+
+instance semigroupParAff :: (Semigroup a) => Semigroup (ParAff e a) where
+  append a b = append <$> a <*> b
+
+instance monoidParAff :: (Monoid a) => Monoid (ParAff e a) where
+  mempty = pure mempty
+
+derive newtype instance functorParAff :: Functor (ParAff e)
+
+instance applyParAff :: Apply (ParAff e) where
+  apply (ParAff ff) (ParAff fa) = ParAff do
     va <- makeVar
     vb <- makeVar
-    c1 <- forkAff (putOrKill va =<< attempt ma)
-    c2 <- forkAff (putOrKill vb =<< attempt mb)
-    f <$> (takeVar va) <*> (takeVar vb)
+    c1 <- forkAff (putOrKill va =<< attempt ff)
+    c2 <- forkAff (putOrKill vb =<< attempt fa)
+    (takeVar va <*> takeVar vb) `cancelWith` (c1 <> c2)
     where
     putOrKill :: forall a. AVar a -> Either Error a -> Aff e Unit
     putOrKill v = either (killVar v) (putVar v)
 
-instance monadRaceAff :: MonadRace (Aff e) where
-  stall = throwError $ error "Stalled"
-  race a1 a2 = do
+derive newtype instance applicativeParAff :: Applicative (ParAff e)
+
+-- | Returns the first value, or the first error if both error.
+instance altParAff :: Alt (ParAff e) where
+  alt (ParAff a1) (ParAff a2) = ParAff do
     va <- makeVar -- the `a` value
     ve <- makeVar -- the error count (starts at 0)
     putVar ve 0
@@ -237,9 +255,18 @@ instance monadRaceAff :: MonadRace (Aff e) where
     maybeKill :: forall a. AVar a -> AVar Int -> Error -> Aff e Unit
     maybeKill va ve err = do
       e <- takeVar ve
-      if e == 1 then killVar va err else pure unit
+      when (e == 1) $ killVar va err
       putVar ve (e + 1)
 
+instance plusParAff :: Plus (ParAff e) where
+  empty = ParAff empty
+
+instance alternativeParAff :: Alternative (ParAff e)
+
+instance parallelParAff :: Parallel (ParAff e) (Aff e) where
+  parallel = ParAff
+  sequential (ParAff ma) = ma
+
 makeVar :: forall e a. Aff e (AVar a)
 makeVar = fromAVBox $ _makeVar nonCanceler
 
@@ -281,4 +308,4 @@ foreign import _runAff :: forall e a. Fn3 (Error -> Eff e Unit) (a -> Eff e Unit
 
 foreign import _liftEff :: forall e a. Fn2 (Canceler e) (Eff e a) (Aff e a)
 
-foreign import _tailRecM :: forall e a b. Fn3 (Either a b -> Boolean) (a -> Aff e (Either a b)) a (Aff e b)
+foreign import _tailRecM :: forall e a b. Fn3 (Step a b -> Boolean) (a -> Aff e (Step a b)) a (Aff e b)

src/Control/Monad/Aff/Class.purs

@@ -2,45 +2,45 @@ module Control.Monad.Aff.Class where
 
 import Prelude
 
-import Control.Monad.Aff (Aff())
-import Control.Monad.Cont.Trans (ContT())
+import Control.Monad.Aff (Aff)
+import Control.Monad.Cont.Trans (ContT)
 import Control.Monad.Eff.Class (class MonadEff)
-import Control.Monad.Except.Trans (ExceptT())
-import Control.Monad.List.Trans (ListT())
-import Control.Monad.Maybe.Trans (MaybeT())
-import Control.Monad.Reader.Trans (ReaderT())
-import Control.Monad.RWS.Trans (RWST())
-import Control.Monad.State.Trans (StateT())
-import Control.Monad.Trans (lift)
-import Control.Monad.Writer.Trans (WriterT())
+import Control.Monad.Except.Trans (ExceptT)
+import Control.Monad.List.Trans (ListT)
+import Control.Monad.Maybe.Trans (MaybeT)
+import Control.Monad.Reader.Trans (ReaderT)
+import Control.Monad.RWS.Trans (RWST)
+import Control.Monad.State.Trans (StateT)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Writer.Trans (WriterT)
 
 import Data.Monoid (class Monoid)
 
-class (MonadEff eff m) <= MonadAff eff m where
+class MonadEff eff m <= MonadAff eff m | m -> eff where
   liftAff :: forall a. Aff eff a -> m a
 
 instance monadAffAff :: MonadAff e (Aff e) where
   liftAff = id
 
-instance monadAffContT :: (MonadAff eff m) => MonadAff eff (ContT r m) where
+instance monadAffContT :: MonadAff eff m => MonadAff eff (ContT r m) where
   liftAff = lift <<< liftAff
 
-instance monadAffExceptT :: (MonadAff eff m) => MonadAff eff (ExceptT e m) where
+instance monadAffExceptT :: MonadAff eff m => MonadAff eff (ExceptT e m) where
   liftAff = lift <<< liftAff
 
-instance monadAffListT :: (MonadAff eff m) => MonadAff eff (ListT m) where
+instance monadAffListT :: MonadAff eff m => MonadAff eff (ListT m) where
   liftAff = lift <<< liftAff
 
-instance monadAffMaybe :: (MonadAff eff m) => MonadAff eff (MaybeT m) where
+instance monadAffMaybe :: MonadAff eff m => MonadAff eff (MaybeT m) where
   liftAff = lift <<< liftAff
 
-instance monadAffReader :: (MonadAff eff m) => MonadAff eff (ReaderT r m) where
+instance monadAffReader :: MonadAff eff m => MonadAff eff (ReaderT r m) where
   liftAff = lift <<< liftAff
 
 instance monadAffRWS :: (MonadAff eff m, Monoid w) => MonadAff eff (RWST r w s m) where
   liftAff = lift <<< liftAff
 
-instance monadAffState :: (MonadAff eff m) => MonadAff eff (StateT s m) where
+instance monadAffState :: MonadAff eff m => MonadAff eff (StateT s m) where
   liftAff = lift <<< liftAff
 
 instance monadAffWriter :: (MonadAff eff m, Monoid w) => MonadAff eff (WriterT w m) where

src/Control/Monad/Aff/Internal.js

@@ -33,14 +33,14 @@ exports._takeVar = function (nonCanceler, avar) {
 };
 
 exports._peekVar = function (nonCanceler, avar) {
-  return function(success, error) {
+  return function (success, error) {
     if (avar.error !== undefined) {
       error(avar.error);
     } else if (avar.producers.length > 0) {
       var producer = avar.producers[0];
       producer(success, error);
     } else {
-      avar.consumers.push({peek: true, success: success, error: error});
+      avar.consumers.push({ peek: true, success: success, error: error });
     }
     return nonCanceler;
   };

src/Control/Monad/Aff/Unsafe.purs

@@ -1,8 +1,7 @@
 module Control.Monad.Aff.Unsafe where
 
-import Prelude (Unit())
-import Control.Monad.Aff (Aff())
+import Control.Monad.Aff (Aff)
+import Unsafe.Coerce (unsafeCoerce)
 
-foreign import unsafeTrace :: forall e a. a -> Aff e Unit
-
-foreign import unsafeInterleaveAff :: forall e1 e2 a. Aff e1 a -> Aff e2 a
+unsafeCoerceAff :: forall e1 e2 a. Aff e1 a -> Aff e2 a
+unsafeCoerceAff = unsafeCoerce

test/Test/Main.purs

@@ -3,8 +3,6 @@ module Test.Main where
 import Prelude
 
 import Control.Alt ((<|>))
-import Control.Apply ((*>))
-import Control.Parallel.Class (parallel, runParallel)
 import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
 import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar)
 import Control.Monad.Aff.Console (CONSOLE, log)
@@ -13,8 +11,9 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log) as Eff
 import Control.Monad.Eff.Exception (EXCEPTION, throwException, error, message, try)
 import Control.Monad.Error.Class (throwError)
-import Control.Monad.Rec.Class (tailRecM)
-import Data.Either (Either(..), either, fromLeft, fromRight)
+import Control.Monad.Rec.Class (Step(..), tailRecM)
+import Control.Parallel (parallel, sequential)
+import Data.Either (either, fromLeft, fromRight)
 import Data.Unfoldable (replicate)
 import Partial.Unsafe (unsafePartial)
 
@@ -116,24 +115,24 @@ test_finally = do
 
 test_parRace :: TestAVar Unit
 test_parRace = do
-  s <- runParallel (parallel (later' 100 $ pure "Success: Early bird got the worm") <|>
+  s <- sequential (parallel (later' 100 $ pure "Success: Early bird got the worm") <|>
                parallel (later' 200 $ pure "Failure: Late bird got the worm"))
   log s
 
 test_parError :: TestAVar Unit
 test_parError = do
-  e <- attempt $ runParallel (parallel (throwError (error ("Oh noes!"))) *> pure unit)
+  e <- attempt $ sequential (parallel (throwError (error ("Oh noes!"))) *> pure unit)
   either (const $ log "Success: Exception propagated") (const $ log "Failure: Exception missing") e
 
 test_parRaceKill1 :: TestAVar Unit
 test_parRaceKill1 = do
-  s <- runParallel (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
+  s <- sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
                parallel (later' 200 $ pure "Success: Early error was ignored in favor of late success"))
   log s
 
 test_parRaceKill2 :: TestAVar Unit
 test_parRaceKill2 = do
-  e <- attempt $ runParallel (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
+  e <- attempt $ sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
                          parallel (later' 200 $ throwError (error ("Oh noes!"))))
   either (const $ log "Success: Killing both kills it dead") (const $ log "Failure: It's alive!!!") e
 
@@ -168,7 +167,7 @@ test_cancelRunLater = do
 
 test_cancelParallel :: TestAVar Unit
 test_cancelParallel = do
-  c  <- forkAff <<< runParallel $ parallel (later' 100 $ log "Failure: #1 should not get through") <|>
+  c  <- forkAff <<< sequential $ parallel (later' 100 $ log "Failure: #1 should not get through") <|>
                              parallel (later' 100 $ log "Failure: #2 should not get through")
   v  <- c `cancel` (error "Must cancel")
   log (if v then "Success: Canceling composite of two Parallel succeeded"
@@ -184,19 +183,19 @@ test_syncTailRecM = do
   where
   go { n: 0, v } = do
     modifyVar (const true) v
-    pure (Right 0)
-  go { n, v } = pure (Left { n: n - 1, v })
+    pure (Done 0)
+  go { n, v } = pure (Loop { n: n - 1, v })
 
 loopAndBounce :: forall eff. Int -> Aff (console :: CONSOLE | eff) Unit
 loopAndBounce n = do
   res <- tailRecM go n
   log $ "Done: " <> show res
   where
-  go 0 = pure (Right 0)
+  go 0 = pure (Done 0)
   go n | mod n 30000 == 0 = do
     later' 10 (pure unit)
-    pure (Left (n - 1))
-  go n = pure (Left (n - 1))
+    pure (Loop (n - 1))
+  go n = pure (Loop (n - 1))
 
 all :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
 all n = do