|
| 1 | +module Effect.AVar |
| 2 | + ( AVar |
| 3 | + , AVarCallback |
| 4 | + , AVarStatus(..) |
| 5 | + , new |
| 6 | + , empty |
| 7 | + , take |
| 8 | + , tryTake |
| 9 | + , put |
| 10 | + , tryPut |
| 11 | + , read |
| 12 | + , tryRead |
| 13 | + , kill |
| 14 | + , status |
| 15 | + , isEmpty |
| 16 | + , isFilled |
| 17 | + , isKilled |
| 18 | + ) where |
| 19 | + |
| 20 | +import Prelude |
| 21 | +import Data.Either (Either(..)) |
| 22 | +import Data.Function.Uncurried as Fn |
| 23 | +import Data.Maybe (Maybe(..)) |
| 24 | +import Effect (Effect) |
| 25 | +import Effect.Exception (Error) |
| 26 | + |
| 27 | +type AVarCallback a = (Either Error a → Effect Unit) |
| 28 | + |
| 29 | +foreign import data AVar ∷ Type → Type |
| 30 | + |
| 31 | +data AVarStatus a |
| 32 | + = Killed Error |
| 33 | + | Filled a |
| 34 | + | Empty |
| 35 | + |
| 36 | +-- | Creates a new empty AVar. |
| 37 | +foreign import empty ∷ ∀ a. Effect (AVar a) |
| 38 | + |
| 39 | +-- | Creates a fresh AVar with an initial value. |
| 40 | +new ∷ ∀ a. a → Effect (AVar a) |
| 41 | +new = _newVar |
| 42 | + |
| 43 | +-- | Kills the AVar with an exception. All pending and future actions will |
| 44 | +-- | resolve immediately with the provided exception. |
| 45 | +kill ∷ ∀ a. Error → AVar a → Effect Unit |
| 46 | +kill err avar = Fn.runFn3 _killVar ffiUtil err avar |
| 47 | + |
| 48 | +-- | Sets the value of the AVar. If the AVar is already filled, it will be |
| 49 | +-- | queued until the value is emptied. Multiple puts will resolve in order as |
| 50 | +-- | the AVar becomes available. Returns an effect which will remove the |
| 51 | +-- | callback from the pending queue. |
| 52 | +put ∷ ∀ a. a → AVar a → AVarCallback Unit → Effect (Effect Unit) |
| 53 | +put value avar cb = Fn.runFn4 _putVar ffiUtil value avar cb |
| 54 | + |
| 55 | +-- | Attempts to synchronously fill an AVar. If the AVar is already filled, |
| 56 | +-- | this will do nothing. Returns true or false depending on if it succeeded. |
| 57 | +tryPut ∷ ∀ a. a → AVar a → Effect Boolean |
| 58 | +tryPut value avar = Fn.runFn3 _tryPutVar ffiUtil value avar |
| 59 | + |
| 60 | +-- | Takes the AVar value, leaving it empty. If the AVar is already empty, |
| 61 | +-- | the callback will be queued until the AVar is filled. Multiple takes will |
| 62 | +-- | resolve in order as the AVar fills. Returns an effect which will remove |
| 63 | +-- | the callback from the pending queue. |
| 64 | +take ∷ ∀ a. AVar a → AVarCallback a → Effect (Effect Unit) |
| 65 | +take avar cb = Fn.runFn3 _takeVar ffiUtil avar cb |
| 66 | + |
| 67 | +-- | Attempts to synchronously take an AVar value, leaving it empty. If the |
| 68 | +-- | AVar is empty, this will return `Nothing`. |
| 69 | +tryTake ∷ ∀ a. AVar a → Effect (Maybe a) |
| 70 | +tryTake avar = Fn.runFn2 _tryTakeVar ffiUtil avar |
| 71 | + |
| 72 | +-- | Reads the AVar value. Unlike `take`, this will not leave the AVar empty. |
| 73 | +-- | If the AVar is empty, this will queue until it is filled. Multiple reads |
| 74 | +-- | will resolve at the same time, as soon as possible. |
| 75 | +read ∷ ∀ a. AVar a → AVarCallback a → Effect (Effect Unit) |
| 76 | +read avar cb = Fn.runFn3 _readVar ffiUtil avar cb |
| 77 | + |
| 78 | +-- | Attempts to synchronously read an AVar. If the AVar is empty, this will |
| 79 | +-- | return `Nothing`. |
| 80 | +tryRead ∷ ∀ a. AVar a → Effect (Maybe a) |
| 81 | +tryRead avar = Fn.runFn2 _tryReadVar ffiUtil avar |
| 82 | + |
| 83 | +-- | Synchronously checks the status of an AVar. |
| 84 | +status ∷ ∀ a. AVar a → Effect (AVarStatus a) |
| 85 | +status avar = Fn.runFn2 _status ffiUtil avar |
| 86 | + |
| 87 | +isEmpty ∷ ∀ a. AVarStatus a → Boolean |
| 88 | +isEmpty = case _ of |
| 89 | + Empty → true |
| 90 | + _ → false |
| 91 | + |
| 92 | +isFilled ∷ ∀ a. AVarStatus a → Boolean |
| 93 | +isFilled = case _ of |
| 94 | + Filled _ → true |
| 95 | + _ → false |
| 96 | + |
| 97 | +isKilled ∷ ∀ a. AVarStatus a → Boolean |
| 98 | +isKilled = case _ of |
| 99 | + Killed _ → true |
| 100 | + _ → false |
| 101 | + |
| 102 | +foreign import _newVar ∷ ∀ a. a → Effect (AVar a) |
| 103 | +foreign import _killVar ∷ ∀ a. Fn.Fn3 FFIUtil Error (AVar a) (Effect Unit) |
| 104 | +foreign import _putVar ∷ ∀ a. Fn.Fn4 FFIUtil a (AVar a) (AVarCallback Unit) (Effect (Effect Unit)) |
| 105 | +foreign import _tryPutVar ∷ ∀ a. Fn.Fn3 FFIUtil a (AVar a) (Effect Boolean) |
| 106 | +foreign import _takeVar ∷ ∀ a. Fn.Fn3 FFIUtil (AVar a) (AVarCallback a) (Effect (Effect Unit)) |
| 107 | +foreign import _tryTakeVar ∷ ∀ a. Fn.Fn2 FFIUtil (AVar a) (Effect (Maybe a)) |
| 108 | +foreign import _readVar ∷ ∀ a. Fn.Fn3 FFIUtil (AVar a) (AVarCallback a) (Effect (Effect Unit)) |
| 109 | +foreign import _tryReadVar ∷ ∀ a. Fn.Fn2 FFIUtil (AVar a) (Effect (Maybe a)) |
| 110 | +foreign import _status ∷ ∀ a. Fn.Fn2 FFIUtil (AVar a) (Effect (AVarStatus a)) |
| 111 | + |
| 112 | +type FFIUtil = |
| 113 | + { left ∷ ∀ a b. a → Either a b |
| 114 | + , right ∷ ∀ a b. b → Either a b |
| 115 | + , nothing ∷ ∀ a. Maybe a |
| 116 | + , just ∷ ∀ a. a → Maybe a |
| 117 | + , killed ∷ ∀ a. Error → AVarStatus a |
| 118 | + , filled ∷ ∀ a. a → AVarStatus a |
| 119 | + , empty ∷ ∀ a. AVarStatus a |
| 120 | + } |
| 121 | + |
| 122 | +ffiUtil ∷ FFIUtil |
| 123 | +ffiUtil = |
| 124 | + { left: Left |
| 125 | + , right: Right |
| 126 | + , nothing: Nothing |
| 127 | + , just: Just |
| 128 | + , killed: Killed |
| 129 | + , filled: Filled |
| 130 | + , empty: Empty |
| 131 | + } |
0 commit comments