├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── bower.json ├── package.json ├── src └── Run │ ├── Streaming.purs │ └── Streaming │ ├── Prelude.purs │ ├── Pull.purs │ └── Push.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psc* 6 | /.purs* 7 | /src/.webpack.js 8 | npm-debug.log 9 | .psa-stash 10 | .vscode 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | dist: trusty 3 | sudo: required 4 | node_js: stable 5 | install: 6 | - npm install 7 | - npm install -g bower 8 | - bower install --production 9 | script: 10 | - npm run -s build 11 | - bower install 12 | - npm run -s test 13 | after_success: 14 | - >- 15 | test $TRAVIS_TAG && 16 | echo $GITHUB_TOKEN | pulp login && 17 | echo y | pulp publish --no-push 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Nathan Faubion 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the "Software"), to deal in the Software without 6 | restriction, including without limitation the rights to use, 7 | copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the 9 | Software is furnished to do so, subject to the following 10 | conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 17 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 19 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 20 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 21 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-run-streaming 2 | 3 | [![Latest release](http://img.shields.io/github/release/natefaubion/purescript-run-streaming.svg)](https://github.com/natefaubion/purescript-run-streaming/releases) 4 | [![Build status](https://travis-ci.org/natefaubion/purescript-run-streaming.svg?branch=master)](https://travis-ci.org/natefaubion/purescript-run-streaming) 5 | 6 | Streaming bidirectional pipes for PureScript. 7 | 8 | ## Install 9 | 10 | ``` 11 | bower install purescript-run-streaming 12 | ``` 13 | 14 | ## Documentation 15 | 16 | - Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-run-streaming). 17 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-run-streaming", 3 | "homepage": "https://github.com/natefaubion/purescript-run-streaming", 4 | "authors": [ 5 | "Nathan Faubion " 6 | ], 7 | "description": "Streaming bidirectional pipes for PureScript", 8 | "license": "MIT", 9 | "keywords": [ 10 | "purescript", 11 | "extensible", 12 | "effects", 13 | "streaming", 14 | "pipes" 15 | ], 16 | "repository": { 17 | "type": "git", 18 | "url": "git://github.com/natefaubion/purescript-run-streaming.git" 19 | }, 20 | "ignore": [ 21 | "**/.*", 22 | "node_modules", 23 | "bower_components", 24 | "output", 25 | "test" 26 | ], 27 | "dependencies": { 28 | "purescript-prelude": "^4.1.0", 29 | "purescript-run": "^2.0.0" 30 | }, 31 | "devDependencies": { 32 | "purescript-psci-support": "^4.0.0", 33 | "purescript-assert": "^4.0.0", 34 | "purescript-console": "^4.1.0", 35 | "purescript-debug": "^4.0.0" 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "pulp build -- --censor-lib --strict", 5 | "test": "pulp test" 6 | }, 7 | "devDependencies": { 8 | "bower": "^1.8.2", 9 | "pulp": "^12.3.0", 10 | "purescript": "^0.12.0", 11 | "purescript-psa": "^0.7.3" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /src/Run/Streaming.purs: -------------------------------------------------------------------------------- 1 | -- | This module defines primitives for bidirectional streams analagous to 2 | -- | the Haskell `Pipes` library. Namely, streams may be either push or pull 3 | -- | and can propagate information both upstream and downstream. 4 | 5 | module Run.Streaming 6 | ( Step(..) 7 | , STEP 8 | , YIELD 9 | , AWAIT 10 | , REQUEST 11 | , RESPOND 12 | , _yield 13 | , _await 14 | , yield 15 | , await 16 | , request 17 | , respond 18 | , Resume(..) 19 | , Producer 20 | , Consumer 21 | , Transformer 22 | , Client 23 | , Server 24 | , Pipe 25 | , runStep 26 | , runYield 27 | , runAwait 28 | , interleave 29 | , substitute 30 | ) where 31 | 32 | import Prelude 33 | 34 | import Data.Profunctor (class Profunctor, dimap) 35 | import Data.Symbol (class IsSymbol) 36 | import Prim.Row (class Cons) 37 | import Run (Run, SProxy(..), FProxy) 38 | import Run as Run 39 | 40 | data Step i o a = Step o (i → a) 41 | 42 | derive instance functorStep ∷ Functor (Step i o) 43 | 44 | type STEP i o = FProxy (Step i o) 45 | 46 | type YIELD a = STEP Unit a 47 | 48 | type AWAIT a = STEP a Unit 49 | 50 | type REQUEST req res = STEP res req 51 | 52 | type RESPOND req res = STEP req res 53 | 54 | _yield ∷ SProxy "yield" 55 | _yield = SProxy 56 | 57 | _await ∷ SProxy "await" 58 | _await = SProxy 59 | 60 | liftYield ∷ ∀ req res r. Step res req ~> Run (yield ∷ STEP res req | r) 61 | liftYield = Run.lift _yield 62 | 63 | liftAwait ∷ ∀ req res r. Step req res ~> Run (await ∷ STEP req res | r) 64 | liftAwait = Run.lift _await 65 | 66 | -- | Yields a response and waits for a request. 67 | respond ∷ ∀ req res r. res → Run (Server req res r) req 68 | respond res = liftYield (Step res identity) 69 | 70 | -- | Issues a request and awaits a response. 71 | request ∷ ∀ req res r. req → Run (Client req res r) res 72 | request req = liftAwait (Step req identity) 73 | 74 | -- | Yields a value to be consumed downstream. 75 | yield ∷ ∀ o r. o → Run (Producer o r) Unit 76 | yield = respond 77 | 78 | -- | Awaits a value upstream. 79 | await ∷ ∀ i r. Run (Consumer i r) i 80 | await = request unit 81 | 82 | -- | Producers yield values of type `o` using effects `r`. 83 | type Producer o r = (yield ∷ YIELD o | r) 84 | 85 | -- | Consumers await values of type `i` using effects `r`. 86 | type Consumer i r = (await ∷ AWAIT i | r) 87 | 88 | -- | Transformers await values `i` and yield values `o` using effects `r`. 89 | type Transformer i o r = (await ∷ AWAIT i, yield ∷ YIELD o | r) 90 | 91 | -- | Servers reply to requests `req` with responses `res` using effects `r`. 92 | type Server req res r = (yield ∷ RESPOND req res | r) 93 | 94 | -- | Clients issue requests `req` and await responses `res` using effects `r`. 95 | type Client req res r = (await ∷ REQUEST req res | r) 96 | 97 | -- | A full bidirectional Pipe acts as an upstream Client and a downstream Server. 98 | type Pipe req res req' res' r = (await ∷ REQUEST req res, yield ∷ RESPOND req' res' | r) 99 | 100 | data Resume r a i o 101 | = Next o (i → Run r (Resume r a i o)) 102 | | Done a 103 | 104 | instance functorResume ∷ Functor (Resume r a i) where 105 | map f = case _ of 106 | Next o k → Next (f o) (map (map f) <$> k) 107 | Done a → Done a 108 | 109 | instance profunctorResume ∷ Profunctor (Resume r a) where 110 | dimap f g = case _ of 111 | Next o k → Next (g o) (dimap f (map (dimap f g)) k) 112 | Done a → Done a 113 | 114 | runStep 115 | ∷ ∀ sym i o r1 r2 a 116 | . Cons sym (FProxy (Step i o)) r1 r2 117 | ⇒ IsSymbol sym 118 | ⇒ SProxy sym 119 | → Run r2 a 120 | → Run r1 (Resume r1 a i o) 121 | runStep p = loop 122 | where 123 | loop = Run.resume 124 | (Run.on p 125 | (\(Step o k) → pure (Next o (k >>> loop))) 126 | (\a → Run.send a >>= loop)) 127 | (pure <<< Done) 128 | 129 | runYield ∷ ∀ r a i o. Run (Server i o r) a → Run r (Resume r a i o) 130 | runYield = runStep _yield 131 | 132 | runAwait ∷ ∀ r a i o. Run (Client i o r) a → Run r (Resume r a o i) 133 | runAwait = runStep _await 134 | 135 | -- | Subsitutes the outputs of the second argument with the continuation of the 136 | -- | first argument, and vice versa, interleaving the two. 137 | interleave ∷ ∀ r a i o. (o → Run r (Resume r a o i)) → Resume r a i o → Run r a 138 | interleave k = case _ of 139 | Next o next → k o >>= interleave next 140 | Done a → pure a 141 | 142 | -- | Substitutes the outputs of the second argument with the effects of the 143 | -- | first argument, feeding the result back in to the stream. 144 | substitute ∷ ∀ r a i o. (o → Run r i) → Resume r a i o → Run r a 145 | substitute k = case _ of 146 | Next o next → k o >>= next >>= substitute k 147 | Done a → pure a 148 | -------------------------------------------------------------------------------- /src/Run/Streaming/Prelude.purs: -------------------------------------------------------------------------------- 1 | module Run.Streaming.Prelude 2 | ( forever 3 | , cat 4 | , map 5 | , filter 6 | , each 7 | , concat 8 | , concatMap 9 | , take 10 | , takeWhile 11 | , drop 12 | , dropWhile 13 | , scan 14 | , zipWith 15 | , zip 16 | , succ 17 | , null 18 | , head 19 | , last 20 | , all 21 | , any 22 | , and 23 | , or 24 | , elem 25 | , find 26 | , index 27 | , findIndex 28 | , fold 29 | , fold' 30 | , foldM 31 | , foldM' 32 | , length 33 | , sum 34 | , product 35 | , minimum 36 | , maximum 37 | , unfold 38 | , module Exports 39 | ) where 40 | 41 | import Prelude hiding (map) 42 | import Prelude as P 43 | import Data.Either (Either(..)) 44 | import Data.Enum as E 45 | import Data.Foldable as F 46 | import Data.Maybe (Maybe(..)) 47 | import Data.Tuple (Tuple(..), fst, snd) 48 | import Run (Run) 49 | import Run.Streaming (Producer, Transformer, yield, await) 50 | import Run.Streaming as RS 51 | import Run.Streaming.Pull as Pull 52 | 53 | -- Reexports 54 | import Run.Streaming (Consumer, Producer, Transformer, Server, Client, Pipe, respond, request, yield, await) as Exports 55 | import Run.Streaming.Pull (feed, into, consume) as Exports 56 | import Run.Streaming.Push (for, traverse, produce) as Exports 57 | 58 | -- | Loop an effect forever. 59 | forever ∷ ∀ r a b. Run r a → Run r b 60 | forever go = go >>= \_ → forever go 61 | 62 | -- | Forwards incoming values downstream. 63 | cat ∷ ∀ r x a. Run (Transformer x x r) a 64 | cat = Pull.identity unit 65 | 66 | -- | Adapts incoming values. 67 | map ∷ ∀ r i o a. (i → o) → Run (Transformer i o r) a 68 | map f = forever (await >>= f >>> yield) 69 | 70 | -- | Filters incoming values based on a predicate. 71 | filter ∷ ∀ r x a. (x → Boolean) → Run (Transformer x x r) a 72 | filter f = forever do 73 | x ← await 74 | when (f x) do 75 | yield x 76 | 77 | -- | Turns an arbitrary Foldable into a Producer. 78 | each ∷ ∀ r x f. F.Foldable f ⇒ f x → Run (Producer x r) Unit 79 | each = F.traverse_ yield 80 | 81 | -- | Forwards all individual values in an incoming Foldable downstream. 82 | concat ∷ ∀ r x f a. F.Foldable f ⇒ Run (Transformer (f x) x r) a 83 | concat = forever (await >>= each) 84 | 85 | -- | Composition of `map` followed by `concat`. 86 | concatMap ∷ ∀ r i o f a. F.Foldable f ⇒ (i → f o) → Run (Transformer i o r) a 87 | concatMap f = forever (await >>= f >>> each) 88 | 89 | -- | Takes a specified number of values from the head of the stream, terminating 90 | -- | upon completion. 91 | take ∷ ∀ r x. Int → Run (Transformer x x r) Unit 92 | take n = 93 | when (n > 0) do 94 | await >>= yield 95 | take (n - 1) 96 | 97 | -- | Takes values from the head of the stream as determined by the provided 98 | -- | predicate. Terminates when the predicate fails. 99 | takeWhile ∷ ∀ r x. (x → Boolean) → Run (Transformer x x r) Unit 100 | takeWhile f = go 101 | where 102 | go = do 103 | x ← await 104 | when (f x) do 105 | yield x 106 | go 107 | 108 | -- | Drops a specified number of values from the head of the stream. 109 | drop ∷ ∀ r x a. Int → Run (Transformer x x r) a 110 | drop n = 111 | if n <= 0 112 | then cat 113 | else do 114 | _ ← await 115 | drop (n - 1) 116 | 117 | -- | Drops values from the head of the stream as determined by the provided 118 | -- | predicate. Forwards all subsequent values. 119 | dropWhile ∷ ∀ r x a. (x → Boolean) → Run (Transformer x x r) a 120 | dropWhile f = go 121 | where 122 | go = do 123 | x ← await 124 | if f x 125 | then do 126 | _ ← await 127 | go 128 | else do 129 | yield x 130 | cat 131 | 132 | -- | Folds over the input, yielding each step. 133 | scan ∷ ∀ r i o x a. (x → i → x) → x → (x → o) → Run (Transformer i o r) a 134 | scan step init done = go init 135 | where 136 | go x = do 137 | yield (done x) 138 | i ← await 139 | go (step x i) 140 | 141 | -- | Joins two Producers into one. 142 | zipWith 143 | ∷ ∀ r i j k a 144 | . (i → j → k) 145 | → Run (Producer i (Producer k r)) a 146 | → Run (Producer j (Producer k r)) a 147 | → Run (Producer k r) a 148 | zipWith f = \ra rb → go (RS.runYield ra) (RS.runYield rb) 149 | where 150 | go ra rb = ra >>= case _ of 151 | RS.Next o k → rb >>= case _ of 152 | RS.Next p j → do 153 | yield (f o p) 154 | go (k unit) (j unit) 155 | RS.Done a → pure a 156 | RS.Done a → pure a 157 | 158 | -- | Joins two Producers with a Tuple. 159 | zip 160 | ∷ ∀ r i j a 161 | . Run (Producer i (Producer (Tuple i j) r)) a 162 | → Run (Producer j (Producer (Tuple i j) r)) a 163 | → Run (Producer (Tuple i j) r) a 164 | zip = zipWith Tuple 165 | 166 | -- | Yields successive values until exhausted. 167 | succ ∷ ∀ r x. E.Enum x ⇒ x → Run (Producer x r) Unit 168 | succ n = do 169 | yield n 170 | F.for_ (E.succ n) succ 171 | 172 | -- | Checks whether a Producer is empty. 173 | null ∷ ∀ r x. Run (Producer x r) Unit → Run r Boolean 174 | null = P.map go <<< RS.runYield 175 | where 176 | go = case _ of 177 | RS.Next _ _ → false 178 | RS.Done _ → true 179 | 180 | -- | Returns the first value of a Producer. 181 | head ∷ ∀ r x. Run (Producer x r) Unit → Run r (Maybe x) 182 | head = P.map go <<< RS.runYield 183 | where 184 | go = case _ of 185 | RS.Next x _ → Just x 186 | RS.Done _ → Nothing 187 | 188 | -- | Returns the last value of a Producer. 189 | last ∷ ∀ r x. Run (Producer x r) Unit → Run r (Maybe x) 190 | last = go Nothing <=< RS.runYield 191 | where 192 | go acc = case _ of 193 | RS.Next x k → k unit >>= go (Just x) 194 | RS.Done _ → pure acc 195 | 196 | -- | Checks if all yielded values from a Producer satisfy the predicate. Stops 197 | -- | as soon as one fails. 198 | all ∷ ∀ r x. (x → Boolean) → Run (Producer x (Producer x r)) Unit → Run r Boolean 199 | all f = null <<< Pull.feed (filter (not f)) 200 | 201 | -- | Checks if any yielded values from a Producer satisfy the predicate. Stops as 202 | -- | soon as one passes. 203 | any ∷ ∀ r x. (x → Boolean) → Run (Producer x (Producer x r)) Unit → Run r Boolean 204 | any f = P.map not <<< null <<< Pull.feed (filter f) 205 | 206 | -- | Checks if all yielded values are true. 207 | and ∷ ∀ r. Run (Producer Boolean (Producer Boolean r)) Unit → Run r Boolean 208 | and = all identity 209 | 210 | -- | Checks if any yielded values are true. 211 | or ∷ ∀ r. Run (Producer Boolean (Producer Boolean r)) Unit → Run r Boolean 212 | or = any identity 213 | 214 | -- | Checks if a value occurs in the stream. 215 | elem ∷ ∀ r x. Eq x ⇒ x → Run (Producer x (Producer x r)) Unit → Run r Boolean 216 | elem = any <<< eq 217 | 218 | -- | Finds the first value that satisfies the provided predicate. 219 | find ∷ ∀ r x. (x → Boolean) → Run (Producer x (Producer x r)) Unit → Run r (Maybe x) 220 | find f = head <<< Pull.feed (filter f) 221 | 222 | -- | Finds the value at the given offset in the stream. 223 | index ∷ ∀ r x. Int → Run (Producer x (Producer x r)) Unit → Run r (Maybe x) 224 | index ix = head <<< Pull.feed (drop ix) 225 | 226 | -- | Finds the index for the first value that satisfies the provided predicate. 227 | findIndex 228 | ∷ ∀ r x 229 | . (x → Boolean) 230 | → Run 231 | (Producer x 232 | (Producer (Tuple Int x) 233 | (Producer (Tuple Int x) r))) 234 | Unit 235 | → Run r (Maybe (Tuple Int x)) 236 | findIndex f = find (f <<< snd) <<< zip (succ 0) 237 | 238 | -- | Folds over a Producer, returning the summary. 239 | fold 240 | ∷ ∀ r i o x 241 | . (x → i → x) 242 | → x 243 | → (x → o) 244 | → Run (Producer i r) Unit 245 | → Run r o 246 | fold step init done ra = 247 | fst <$> fold' step init done ra 248 | 249 | -- | Folds over a Producer, but also returns the final value of the stream. 250 | fold' 251 | ∷ ∀ r i o x a 252 | . (x → i → x) 253 | → x 254 | → (x → o) 255 | → Run (Producer i r) a 256 | → Run r (Tuple o a) 257 | fold' step init done ra = RS.runYield ra >>= go init 258 | where 259 | go acc = case _ of 260 | RS.Next o k → k unit >>= go (step acc o) 261 | RS.Done a → pure (Tuple (done acc) a) 262 | 263 | -- | Folds over a Producer with `Run` effects. 264 | foldM 265 | ∷ ∀ r i o x 266 | . (x → i → Run r x) 267 | → Run r x 268 | → (x → Run r o) 269 | → Run (Producer i r) Unit 270 | → Run r o 271 | foldM step init done ra = 272 | fst <$> foldM' step init done ra 273 | 274 | -- | Folds over a Producer with `Run` effects, but also returns the final value 275 | -- | of the stream. 276 | foldM' 277 | ∷ ∀ r i o x a 278 | . (x → i → Run r x) 279 | → Run r x 280 | → (x → Run r o) 281 | → Run (Producer i r) a 282 | → Run r (Tuple o a) 283 | foldM' step init done ra = do 284 | acc ← init 285 | RS.runYield ra >>= go acc 286 | where 287 | go acc = case _ of 288 | RS.Next o k → do 289 | acc' ← step acc o 290 | k unit >>= go acc' 291 | RS.Done a → do 292 | o ← done acc 293 | pure (Tuple o a) 294 | 295 | -- | Returns the number of values yielded by a Producer. 296 | length ∷ ∀ r x. Run (Producer x r) Unit → Run r Int 297 | length = fold (const <<< add 1) 0 identity 298 | 299 | -- | Returns the sum of values yielded by a Producer. 300 | sum ∷ ∀ r x. Semiring x ⇒ Run (Producer x r) Unit → Run r x 301 | sum = fold (+) zero identity 302 | 303 | -- | Returns the product of values yielded by a Producer. 304 | product ∷ ∀ r x. Semiring x ⇒ Run (Producer x r) Unit → Run r x 305 | product = fold (*) one identity 306 | 307 | -- | Returns the minimum value yielded by a Producer. 308 | minimum ∷ ∀ r x. Ord x ⇒ Run (Producer x r) Unit → Run r (Maybe x) 309 | minimum = fold go Nothing identity 310 | where 311 | go x y = Just case x of 312 | Nothing → y 313 | Just x' → min x' y 314 | 315 | -- | Returns the maximum value yielded by a Producer. 316 | maximum ∷ ∀ r x. Ord x ⇒ Run (Producer x r) Unit → Run r (Maybe x) 317 | maximum = fold go Nothing identity 318 | where 319 | go x y = Just case x of 320 | Nothing → y 321 | Just x' → max x' y 322 | 323 | -- | Unfold into a Producer given a seed. 324 | unfold ∷ ∀ r x o a. (x → Either a (Tuple o x)) → x → Run (Producer o r) a 325 | unfold f = go 326 | where 327 | go x = case f x of 328 | Left a → pure a 329 | Right (Tuple o x') → do 330 | yield o 331 | go x' 332 | -------------------------------------------------------------------------------- /src/Run/Streaming/Pull.purs: -------------------------------------------------------------------------------- 1 | -- | This modules defines primitive fusion operations for pull streams. 2 | 3 | module Run.Streaming.Pull 4 | ( identity 5 | , chain 6 | , traverse 7 | , for 8 | , compose 9 | , composeFlipped 10 | , draw 11 | , feed 12 | , from 13 | , into 14 | , consume 15 | ) where 16 | 17 | import Prelude hiding (compose, identity) 18 | import Run (Run) 19 | import Run.Streaming as RS 20 | 21 | identity ∷ ∀ r i o a. i → Run (RS.Pipe i o i o r) a 22 | identity i = RS.request i >>= \o → RS.respond o >>= identity 23 | 24 | -- | Connects a Server to a Client which can fulfill requests from the Client. 25 | chain ∷ ∀ r i o a. (i → Run (RS.Server i o r) a) → Run (RS.Client i o r) a → Run r a 26 | chain k ra = RS.runAwait ra >>= RS.interleave (RS.runYield <$> k) 27 | 28 | -- | Fulfills a Client with effects. 29 | traverse ∷ ∀ r i o a. (i → Run r o) → Run (RS.Client i o r) a → Run r a 30 | traverse k ra = RS.runAwait ra >>= RS.substitute k 31 | 32 | -- | `traverse` with the arguments flipped. 33 | for ∷ ∀ r i o a. Run (RS.Client i o r) a → (i → Run r o) → Run r a 34 | for = flip traverse 35 | 36 | -- | Point-free pull composition. 37 | compose 38 | ∷ ∀ r i o x a 39 | . (i → Run (RS.Server i o r) a) 40 | → (x → Run (RS.Client i o r) a) 41 | → (x → Run r a) 42 | compose ra rb x = chain ra (rb x) 43 | 44 | -- | `compose` with the arguments flipped. 45 | composeFlipped 46 | ∷ ∀ r i o x a 47 | . (x → Run (RS.Client i o r) a) 48 | → (i → Run (RS.Server i o r) a) 49 | → (x → Run r a) 50 | composeFlipped = flip compose 51 | 52 | -- | Connects a Consumer to a Producer. 53 | feed ∷ ∀ r x a. Run (RS.Consumer x r) a → Run (RS.Producer x r) a → Run r a 54 | feed ra rb = chain (const rb) ra 55 | 56 | -- | Connects a Producer to a Consumer. 57 | draw ∷ ∀ r x a. Run (RS.Producer x r) a → Run (RS.Consumer x r) a → Run r a 58 | draw rb ra = chain (const rb) ra 59 | 60 | -- | Connects a Consumer to an effect which fulfills the request. 61 | into ∷ ∀ r x a. Run (RS.Consumer x r) a → Run r x → Run r a 62 | into ra rb = for ra (const rb) 63 | 64 | -- | Connect an effect to a Consumer, fulfilling the request. 65 | from ∷ ∀ r x a. Run r x → Run (RS.Consumer x r) a → Run r a 66 | from ra rb = for rb (const ra) 67 | 68 | -- | Consumes all values with effects. 69 | consume ∷ ∀ r x a b. (x → Run (RS.Consumer x r) a) → Run (RS.Consumer x r) b 70 | consume f = go 71 | where 72 | go = do 73 | _ ← f =<< RS.await 74 | go 75 | -------------------------------------------------------------------------------- /src/Run/Streaming/Push.purs: -------------------------------------------------------------------------------- 1 | -- | This modules defines primitive fusion operations for push streams. 2 | 3 | module Run.Streaming.Push 4 | ( identity 5 | , chain 6 | , traverse 7 | , for 8 | , compose 9 | , composeFlipped 10 | , produce 11 | ) where 12 | 13 | import Prelude hiding (compose, identity) 14 | import Run (Run) 15 | import Run.Streaming as RS 16 | 17 | identity ∷ ∀ r i o a. o → Run (RS.Pipe i o i o r) a 18 | identity o = RS.respond o >>= \i → RS.request i >>= identity 19 | 20 | -- | Connects a Client to a Server which can react to responses from the Server. 21 | chain ∷ ∀ r i o a. (o → Run (RS.Client i o r) a) → Run (RS.Server i o r) a → Run r a 22 | chain k ra = RS.runYield ra >>= RS.interleave (RS.runAwait <$> k) 23 | 24 | -- | Loops over a Server/Producer with effects, feeding the result in as a request. 25 | traverse ∷ ∀ r i o a. (o → Run r i) → Run (RS.Server i o r) a → Run r a 26 | traverse k ra = RS.runYield ra >>= RS.substitute k 27 | 28 | -- | `traverse` with the arguments flipped. 29 | for ∷ ∀ r i o a. Run (RS.Server i o r) a → (o → Run r i) → Run r a 30 | for = flip traverse 31 | 32 | -- | Point-free push composition. 33 | compose 34 | ∷ ∀ r i o x a 35 | . (o → Run (RS.Client i o r) a) 36 | → (x → Run (RS.Server i o r) a) 37 | → (x → Run r a) 38 | compose ra rb x = chain ra (rb x) 39 | 40 | -- | `compose` with the arguments flipped. 41 | composeFlipped 42 | ∷ ∀ r i o x a 43 | . (x → Run (RS.Server i o r) a) 44 | → (o → Run (RS.Client i o r) a) 45 | → (x → Run r a) 46 | composeFlipped = flip compose 47 | 48 | -- | Produce values via an effect. 49 | produce ∷ ∀ r x a. Run (RS.Producer x r) x → Run (RS.Producer x r) a 50 | produce f = go 51 | where 52 | go = do 53 | RS.yield =<< f 54 | go 55 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude hiding (map) 4 | 5 | import Data.Array as A 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Tuple (Tuple(..)) 8 | import Effect (Effect) 9 | import Effect.Console (log) 10 | import Run (Run, extract) 11 | import Run.Streaming.Prelude as S 12 | import Run.Streaming.Pull as Pull 13 | import Run.Streaming.Push as Push 14 | import Test.Assert (assert') 15 | 16 | assert ∷ String → Boolean → Effect Unit 17 | assert label ok 18 | | ok = log ("[OK] " <> label) 19 | | otherwise = log ("[xx] " <> label) *> assert' label ok 20 | 21 | toArray ∷ ∀ x. Run (S.Producer x ()) Unit → Array x 22 | toArray = extract <<< S.fold A.snoc [] identity 23 | 24 | -- Push based take 25 | take' ∷ ∀ x r. Int → x → Run (S.Transformer x x r) Unit 26 | take' 0 _ = pure unit 27 | take' n x = S.yield x >>= S.request >>= take' (n - 1) 28 | 29 | data Req = A Int | B Int 30 | type Rep = String 31 | 32 | main ∷ Effect Unit 33 | main = do 34 | assert "pull/take" 35 | let 36 | test = 37 | S.succ 1 38 | # S.feed (S.take 10) 39 | # toArray 40 | in 41 | test == 1 A... 10 42 | 43 | assert "push/take" 44 | let 45 | test = 46 | S.succ 1 47 | # Push.chain (take' 10) 48 | # toArray 49 | in 50 | test == 1 A... 10 51 | 52 | assert "pull/map" 53 | let 54 | test = 55 | S.succ 1 56 | # S.feed (S.map show) 57 | # S.feed (S.take 10) 58 | # toArray 59 | in 60 | test == (show <$> 1 A... 10) 61 | 62 | assert "pull/filter" 63 | let 64 | test = 65 | S.succ 1 66 | # S.feed (S.filter \n → n/2*2 == n) 67 | # S.feed (S.take 5) 68 | # toArray 69 | in 70 | test == [2, 4, 6, 8, 10] 71 | 72 | assert "push/each" 73 | let 74 | test = 75 | S.each (1 A... 10) 76 | # toArray 77 | in 78 | test == (1 A... 10) 79 | 80 | assert "pull/concat" 81 | let 82 | test = 83 | S.each [Just 1, Nothing, Just 3, Just 4] 84 | # S.feed S.concat 85 | # toArray 86 | in 87 | test == [1, 3, 4] 88 | 89 | assert "pull/concatMap" 90 | let 91 | test = 92 | S.succ 1 93 | # S.feed (S.concatMap \n → if n/2*2 == n then Just n else Nothing) 94 | # S.feed (S.take 5) 95 | # toArray 96 | in 97 | test == [2, 4, 6, 8, 10] 98 | 99 | assert "pull/takeWhile" 100 | let 101 | test = 102 | S.succ 1 103 | # S.feed (S.takeWhile (_ <= 10)) 104 | # toArray 105 | in 106 | test == 1 A... 10 107 | 108 | assert "pull/drop" 109 | let 110 | test = 111 | S.succ 1 112 | # S.feed (S.drop 10) 113 | # S.feed (S.take 10) 114 | # toArray 115 | in 116 | test == 11 A... 20 117 | 118 | assert "pull/dropWhile" 119 | let 120 | test = 121 | S.succ 1 122 | # S.feed (S.dropWhile (_ <= 10)) 123 | # S.feed (S.take 10) 124 | # toArray 125 | in 126 | test == 11 A... 20 127 | 128 | assert "pull/scan" 129 | let 130 | test = 131 | S.succ 1 132 | # S.feed (S.scan (+) 0 show) 133 | # S.feed (S.take 5) 134 | # toArray 135 | in 136 | test == ["0", "1", "3", "6", "10"] 137 | 138 | assert "push/zipWith" 139 | let 140 | test = 141 | S.zipWith (+) (S.succ 1) (S.succ 1) 142 | # S.feed (S.take 5) 143 | # toArray 144 | in 145 | test == [2, 4, 6, 8, 10] 146 | 147 | assert "null" 148 | let 149 | test = 150 | S.each [] 151 | # S.null 152 | in 153 | extract test 154 | 155 | assert "head" 156 | let 157 | test = 158 | S.succ 1 159 | # S.head 160 | in 161 | extract test == Just 1 162 | 163 | assert "last" 164 | let 165 | test = 166 | S.succ 1 167 | # S.feed (S.take 10) 168 | # S.last 169 | in 170 | extract test == Just 10 171 | 172 | assert "all/true" 173 | let 174 | test = 175 | S.succ 1 176 | # S.feed (S.take 10) 177 | # S.all (_ < 11) 178 | in 179 | extract test 180 | 181 | assert "all/false" 182 | let 183 | test = 184 | S.succ 1 185 | # S.feed (S.take 10) 186 | # S.all (_ < 10) 187 | in 188 | not extract test 189 | 190 | assert "any/true" 191 | let 192 | test = 193 | S.succ 1 194 | # S.feed (S.take 10) 195 | # S.any (_ > 5) 196 | in 197 | extract test 198 | 199 | assert "any/false" 200 | let 201 | test = 202 | S.succ 1 203 | # S.feed (S.take 10) 204 | # S.any (_ > 10) 205 | in 206 | not extract test 207 | 208 | assert "elem/true" 209 | let 210 | test = 211 | S.succ 1 212 | # S.feed (S.take 10) 213 | # S.elem 5 214 | in 215 | extract test 216 | 217 | assert "elem/false" 218 | let 219 | test = 220 | S.succ 1 221 | # S.feed (S.take 10) 222 | # S.elem 11 223 | in 224 | not extract test 225 | 226 | assert "find" 227 | let 228 | test = 229 | S.succ 1 230 | # S.find (_ == 5) 231 | in 232 | extract test == Just 5 233 | 234 | assert "index" 235 | let 236 | test = 237 | S.succ 1 238 | # S.index 4 239 | in 240 | extract test == Just 5 241 | 242 | assert "findIndex" 243 | let 244 | test = 245 | S.succ 1 246 | # S.findIndex (_ == 5) 247 | in 248 | extract test == Just (Tuple 4 5) 249 | 250 | assert "length" 251 | let 252 | test = 253 | S.succ 1 254 | # S.feed (S.take 10) 255 | # S.length 256 | in 257 | extract test == 10 258 | 259 | assert "sum" 260 | let 261 | test = 262 | S.succ 1 263 | # S.feed (S.take 10) 264 | # S.sum 265 | in 266 | extract test == 55 267 | 268 | assert "product" 269 | let 270 | test = 271 | S.succ 1 272 | # S.feed (S.take 10) 273 | # S.product 274 | in 275 | extract test == 3628800 276 | 277 | assert "minimum" 278 | let 279 | test = 280 | S.each (10 A... 1) 281 | # S.minimum 282 | in 283 | extract test == Just 1 284 | 285 | assert "maximum" 286 | let 287 | test = 288 | S.each (1 A... 10) 289 | # S.maximum 290 | in 291 | extract test == Just 10 292 | 293 | assert "server/client" 294 | let 295 | client = 296 | S.for (S.succ 1) \n → do 297 | s ← S.request if n/2*2 /= n then A n else B n 298 | S.yield s 299 | 300 | server m req = 301 | S.respond case req of 302 | A n → "A: " <> show n <> " @ " <> show m 303 | B n → "B: " <> show n <> " @ " <> show m 304 | >>= server (m + 10) 305 | 306 | test = 307 | client 308 | # Pull.chain (server 10) 309 | # S.feed (S.take 4) 310 | # toArray 311 | in 312 | test == 313 | [ "A: 1 @ 10" 314 | , "B: 2 @ 20" 315 | , "A: 3 @ 30" 316 | , "B: 4 @ 40" 317 | ] 318 | --------------------------------------------------------------------------------