-
Notifications
You must be signed in to change notification settings - Fork 11
Moves back to using a List of AVars for the listeners #6
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Merged
Merged
Changes from all commits
Commits
File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,5 @@ | ||
{- | ||
Copyright 2016 SlamData, Inc. | ||
Copyright 2018 SlamData, Inc. | ||
|
||
Licensed under the Apache License, Version 2.0 (the "License"); | ||
you may not use this file except in compliance with the License. | ||
|
@@ -30,13 +30,18 @@ module Control.Monad.Aff.Bus | |
) where | ||
|
||
import Prelude | ||
import Control.Monad.Aff (Aff, Error) | ||
import Control.Monad.Aff.AVar (AVar, AVAR, makeEmptyVar, takeVar, tryPutVar, readVar, killVar) | ||
|
||
import Control.Monad.Aff (Aff, attempt, forkAff) | ||
import Control.Monad.Aff.AVar (AVAR, AVar, killVar, makeEmptyVar, makeVar, putVar, takeVar) | ||
import Control.Monad.Eff.Exception as Exn | ||
import Data.Foldable (foldl, sequence_, traverse_) | ||
import Data.List (List, (:)) | ||
import Data.Monoid (mempty) | ||
import Data.Tuple (Tuple(..)) | ||
|
||
data Cap | ||
|
||
newtype Bus (r ∷ # Type) a = Bus (AVar a) | ||
data Bus (r ∷ # Type) a = Bus (AVar a) (AVar (List (AVar a))) | ||
|
||
type BusR = BusR' () | ||
|
||
|
@@ -50,20 +55,38 @@ type BusRW = Bus (read ∷ Cap, write ∷ Cap) | |
|
||
-- | Creates a new bidirectional Bus which can be read from and written to. | ||
make ∷ ∀ eff a. Aff (avar ∷ AVAR | eff) (BusRW a) | ||
make = Bus <$> makeEmptyVar | ||
make = do | ||
cell ← makeEmptyVar | ||
consumers ← makeVar mempty | ||
let | ||
loop = do | ||
attempt (takeVar cell) >>= traverse_ \res → do | ||
vars ← takeVar consumers | ||
putVar mempty consumers | ||
sequence_ (foldl (\xs a → putVar res a : xs) mempty vars) | ||
loop | ||
_ ← forkAff loop | ||
pure $ Bus cell consumers | ||
|
||
-- | Blocks until a new value is pushed to the Bus, returning the value. | ||
read ∷ ∀ eff a r. BusR' r a → Aff (avar ∷ AVAR | eff) a | ||
read (Bus avar) = readVar avar | ||
read (Bus _ consumers) = do | ||
res' ← makeEmptyVar | ||
cs ← takeVar consumers | ||
putVar (res' : cs) consumers | ||
takeVar res' | ||
|
||
-- | Pushes a new value to the Bus, yieldig immediately. | ||
write ∷ ∀ eff a r. a → BusW' r a → Aff (avar ∷ AVAR | eff) Unit | ||
write a (Bus avar) = tryPutVar a avar *> void (takeVar avar) | ||
write a (Bus cell _) = putVar a cell | ||
|
||
-- | Splits a bidirectional Bus into separate read and write Buses. | ||
split ∷ ∀ a. BusRW a → Tuple (BusR a) (BusW a) | ||
split (Bus avar) = Tuple (Bus avar) (Bus avar) | ||
split (Bus a b) = Tuple (Bus a b) (Bus a b) | ||
|
||
-- | Kills the Bus and propagates the exception to all consumers. | ||
kill ∷ ∀ eff a r. Error → BusW' r a → Aff (avar ∷ AVAR | eff) Unit | ||
kill err (Bus avar) = killVar err avar | ||
kill ∷ ∀ eff a r. Exn.Error → BusW' r a → Aff (avar ∷ AVAR | eff) Unit | ||
kill err (Bus cell consumers) = do | ||
killVar err cell | ||
vars ← takeVar consumers | ||
traverse_ (killVar err) vars | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This used to kill |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This might need to be an unsafe fork (
liftEff <<< launchAff
) unless you want to let users to control the lifecycle of the loop withsupervised
.There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Changing that line to
_ ← liftEff (launchAff (forkAff loop))
explodes the tests with:Looks like it's maybe a bug in Aff?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
purescript-contrib/purescript-aff#145