Update for new Aff/AVar (#4)

* Update for new Aff/AVar

* Remove debug arg

* Update Aff

* Bump aff version

bower.json

@@ -24,8 +24,9 @@
   ],
   "dependencies": {
     "purescript-prelude": "^3.0.0",
-    "purescript-aff": "^3.0.0",
-    "purescript-lists": "^4.0.0",
-    "purescript-foldable-traversable": "^3.0.0"
+    "purescript-aff": "^4.0.0"
+  },
+  "devDependencies": {
+    "purescript-refs": "^3.0.0"
   }
 }

src/Control/Monad/Aff/Bus.purs

@@ -17,7 +17,6 @@ limitations under the License.
 module Control.Monad.Aff.Bus
   ( make
   , read
-  , read'
   , write
   , split
   , kill
@@ -31,18 +30,13 @@ module Control.Monad.Aff.Bus
   ) where
 
 import Prelude
-import Control.Monad.Aff (forkAff)
-import Control.Monad.Aff.AVar (AffAVar, AVar, makeVar', makeVar, takeVar, putVar, modifyVar, killVar)
-import Control.Monad.Eff.Exception as Exn
-import Control.Monad.Rec.Class (forever)
-import Data.Foldable (foldl, sequence_, traverse_)
-import Data.List (List, (:))
-import Data.Monoid (mempty)
+import Control.Monad.Aff (Aff, Error)
+import Control.Monad.Aff.AVar (AVar, AVAR, makeEmptyVar, takeVar, tryPutVar, readVar, killVar)
 import Data.Tuple (Tuple(..))
 
 data Cap
 
-data Bus (r ∷ # Type) a = Bus (AVar a) (AVar (List (AVar a)))
+newtype Bus (r ∷ # Type) a = Bus (AVar a)
 
 type BusR = BusR' ()
 
@@ -55,40 +49,21 @@ type BusW' r = Bus (write ∷ Cap | r)
 type BusRW = Bus (read ∷ Cap, write ∷ Cap)
 
 -- | Creates a new bidirectional Bus which can be read from and written to.
-make ∷ ∀ eff a. AffAVar eff (BusRW a)
-make = do
-  cell ∷ AVar a ← makeVar
-  consumers ∷ AVar (List (AVar a)) ← makeVar' mempty
-  _ ← forkAff $ forever do
-    res ← takeVar cell
-    vars ← takeVar consumers
-    putVar consumers mempty
-    sequence_ (foldl (\xs a → putVar a res : xs) mempty vars)
-  pure $ Bus cell consumers
+make ∷ ∀ eff a. Aff (avar ∷ AVAR | eff) (BusRW a)
+make = Bus <$> makeEmptyVar
 
 -- | Blocks until a new value is pushed to the Bus, returning the value.
-read ∷ ∀ eff a r. BusR' r a → AffAVar eff a
-read = takeVar <=< read'
-
--- | Returns an AVar that will yield a one-time value.
-read' ∷ ∀ eff a r. BusR' r a → AffAVar eff (AVar a)
-read' (Bus _ consumers) = do
-  res' ← makeVar
-  modifyVar (res' : _) consumers
-  pure res'
+read ∷ ∀ eff a r. BusR' r a → Aff (avar ∷ AVAR | eff) a
+read (Bus avar) = readVar avar
 
 -- | Pushes a new value to the Bus, yieldig immediately.
-write ∷ ∀ eff a r. a → BusW' r a → AffAVar eff Unit
-write a (Bus cell _) = putVar cell a
+write ∷ ∀ eff a r. a → BusW' r a → Aff (avar ∷ AVAR | eff) Unit
+write a (Bus avar) = tryPutVar a avar *> void (takeVar avar)
 
 -- | Splits a bidirectional Bus into separate read and write Buses.
 split ∷ ∀ a. BusRW a → Tuple (BusR a) (BusW a)
-split (Bus a b) = Tuple (Bus a b) (Bus a b)
+split (Bus avar) = Tuple (Bus avar) (Bus avar)
 
 -- | Kills the Bus and propagates the exception to all consumers.
-kill ∷ ∀ eff a r. Exn.Error → BusW' r a → AffAVar eff Unit
-kill err (Bus cell consumers) = do
-  killVar cell err
-  vars ← takeVar consumers
-  killVar consumers err
-  traverse_ (flip killVar err) vars
+kill ∷ ∀ eff a r. Error → BusW' r a → Aff (avar ∷ AVAR | eff) Unit
+kill err (Bus avar) = killVar err avar

test/Main.purs

@@ -17,19 +17,22 @@ limitations under the License.
 module Test.Main where
 
 import Prelude
-import Control.Monad.Aff (Aff, forkAff, launchAff, attempt)
-import Control.Monad.Aff.AVar (AVAR, makeVar', modifyVar, peekVar)
+import Control.Monad.Aff (Aff, forkAff, launchAff, joinFiber, attempt)
+import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Aff.Bus as Bus
 import Control.Monad.Aff.Console (log)
 import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Console (CONSOLE)
-import Control.Monad.Eff.Exception (EXCEPTION, error, message)
+import Control.Monad.Eff.Exception (EXCEPTION, error)
+import Control.Monad.Eff.Ref (REF, newRef, readRef, modifyRef)
 import Control.Monad.Error.Class (throwError)
 import Data.Either (Either(..))
 
 type Effects eff =
   ( console ∷ CONSOLE
   , avar ∷ AVAR
+  , ref ∷ REF
   | eff
   )
 
@@ -39,28 +42,31 @@ assert a = unless a (throwError (error "Assertion failed"))
 test_readWrite ∷ ∀ eff. Aff (Effects eff) Unit
 test_readWrite = do
   bus ← Bus.make
-  avar ← makeVar' 0
+  ref ← liftEff $ newRef 0
 
   let
     proc = do
       res ← attempt (Bus.read bus)
       case res of
         Left e  → do
-          modifyVar (_ + 100) avar
-          log (message e)
+          liftEff $ modifyRef ref (_ + 100)
         Right n → do
-          modifyVar (_ + n) avar
+          liftEff $ modifyRef ref (_ + n)
           proc
 
-  void $ forkAff proc
-  void $ forkAff proc
+  f1 ← forkAff proc
+  f2 ← forkAff proc
 
   Bus.write 1 bus
   Bus.write 2 bus
   Bus.write 3 bus
   Bus.kill (error "Done") bus
 
-  assert <<< eq 212 =<< peekVar avar
+  joinFiber f1
+  joinFiber f2
+
+  res <- liftEff $ readRef ref
+  assert (res == 212)
   log "OK"
 
 main ∷ Eff (Effects (exception ∷ EXCEPTION)) Unit