├── .gitignore
├── .travis.yml
├── LICENSE
├── Makefile
├── README.md
├── default.nix
├── pipes.ipkg
├── rebuild.sh
├── src
    ├── Pipes.idr
    └── Pipes
    │   ├── Core.idr
    │   └── Prelude.idr
└── tests
    ├── Main.idr
    ├── Test
        ├── Pipes.idr
        ├── Tutorial.idr
        ├── Utils.idr
        └── test.txt
    ├── test.ipkg
    ├── tests.sh
    └── tutorial.sh


/.gitignore:
--------------------------------------------------------------------------------
1 | *.ibc
2 | .DS_Store
3 | 


--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: nix
2 | script: nix-shell -A IdrisReducers --command "bash rebuild.sh"
3 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | BSD 3-Clause License
 2 | 
 3 | Copyright (c) 2017, Quentin Duval
 4 | All rights reserved.
 5 | 
 6 | Redistribution and use in source and binary forms, with or without
 7 | modification, are permitted provided that the following conditions are met:
 8 | 
 9 | * Redistributions of source code must retain the above copyright notice, this
10 |   list of conditions and the following disclaimer.
11 | 
12 | * Redistributions in binary form must reproduce the above copyright notice,
13 |   this list of conditions and the following disclaimer in the documentation
14 |   and/or other materials provided with the distribution.
15 | 
16 | * Neither the name of the copyright holder nor the names of its
17 |   contributors may be used to endorse or promote products derived from
18 |   this software without specific prior written permission.
19 | 
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | all: install
 2 | 
 3 | install: build
 4 | 	idris --install pipes.ipkg
 5 | 
 6 | build: src/Pipes/*.idr
 7 | 	idris --build pipes.ipkg
 8 | 
 9 | test: build
10 | 	(cd tests; bash tests.sh)
11 | 
12 | clean:
13 | 	idris --clean pipes.ipkg
14 | 	rm -f tests/*.ibc
15 | 
16 | tuto: build
17 | 	(cd tests; bash tutorial.sh)
18 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # IdrisPipes
 2 | 
 3 | [![Build Status](https://travis-ci.org/QuentinDuval/IdrisPipes.svg?branch=master)](https://travis-ci.org/QuentinDuval/IdrisPipes)
 4 | 
 5 | <br>
 6 | 
 7 | ## Goal
 8 | 
 9 | The goal of this package is to provide Idris with a library for composable and effectful production, transformation and consumption of streams of data. IdrisPipes aims at providing the means to write:
10 | 
11 | * Effectful programs, with side effects such as IO
12 | * Over a stream of data, potentially infinite
13 | * Efficiently, by streaming data and controlling memory consumption
14 | * In a composable way, allowing problem decomposition and reuse
15 | 
16 | IdrisPipes is inspired by the work done in the Haskell community and in particular the following packages:
17 | 
18 | * https://hackage.haskell.org/package/pipes
19 | * https://hackage.haskell.org/package/conduit
20 | 
21 | <br>
22 | 
23 | ## Examples
24 | 
25 | The following code will continuously read inputs from the standard output, and echoing them with a prompt, until it receives a "quit" command and stops:
26 | 
27 |     echo_example : IO ()
28 |     echo_example = runEffect $
29 |       stdinLn                       -- Read the standard output
30 |         .| takingWhile (/= "quit")  -- Stop upon encountering "quit"
31 |         .| mapping ("> " ++)        -- Add the prompt to the string
32 |         .| stdoutLn                 -- Echo the string
33 | 
34 | The following code walks over the integers from 1 to 10, keeping only the even number and multiplying them by 2. We can consume this stream of data by summing or multiplying them:
35 | 
36 |     let ints = each [1..10] .| filtering even .| mapping (*2)
37 | 
38 |     runPure $ ints .| fold (+) 0
39 |     > 60
40 | 
41 |     runPure $ ints .| fold (*) 1
42 |     > 122880
43 | 
44 | We can also interleave effects inside the computations over a stream of data. For instance, the following code will print the numbers that goes through the pipes:
45 | 
46 |     runPipe $ each [1..10] .| tracing printLn .| fold (+) 0
47 |     > 1   -- Print the first number going through the pipe
48 |     > ...
49 |     > 10  -- Print the last number going through the pipe
50 |     > 55  -- The result of the computation = 1 + .. + 10
51 | 
52 | The pipe follows pull-based streaming model. The downstream consumption will drive it, asking for more values when needed. It might not consume the stream entirely, in which case only those effects that are needed to reach this stage of the computation will be triggered and made visible:
53 | 
54 |     runPipe $ each [1..10] .| tracing printLn .| takingWhile (< 5) .| fold (+) 0
55 |     > 1   -- Print the first number going through the pipe
56 |     > ...
57 |     > 5   -- Print the last number going through the pipe (not taken in the sum)
58 |     > 10  -- The result of the computation = 1 + .. + 4
59 | 
60 | <br>
61 | 
62 | ## Installing the package
63 | 
64 | You can install IdrisPipes by using the following `make` command:
65 | 
66 |     make install
67 | 
68 | The Makefile also contains some more targets that you may find useful:
69 | 
70 |     make build -- Build the library
71 |     make test  -- Run the test suite
72 |     make tuto  -- Run a REPL on the tutorial
73 | 
74 | <br>
75 | 
76 | ## Documentation & Resources
77 | 
78 | You can find some more information on this library on my blog:
79 | 
80 | * https://deque.blog/2017/11/02/idrispipes-a-library-for-composable-and-effectful-stream-processing-in-idris/
81 | 
82 | <br>
83 | 
84 | 


--------------------------------------------------------------------------------
/default.nix:
--------------------------------------------------------------------------------
 1 | # This is used in the Travis build to install the Idris compiler.
 2 | let
 3 |   pkgs = import <nixpkgs> {};
 4 |   stdenv = pkgs.stdenv;
 5 | in {
 6 |   IdrisReducers = stdenv.mkDerivation {
 7 |     name = "IdrisPipes";
 8 |     src = ./.;
 9 |     buildInputs = with pkgs; [ haskellPackages.idris gmp ];
10 |   };
11 | }
12 | 


--------------------------------------------------------------------------------
/pipes.ipkg:
--------------------------------------------------------------------------------
 1 | package pipes
 2 | 
 3 | sourceloc = https://github.com/QuentinDuval/IdrisPipes.git
 4 | 
 5 | sourcedir = src
 6 | 
 7 | modules = Pipes
 8 |         , Pipes.Core
 9 |         , Pipes.Prelude
10 | 


--------------------------------------------------------------------------------
/rebuild.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | 
3 | make clean
4 | make build
5 | make test
6 | 


--------------------------------------------------------------------------------
/src/Pipes.idr:
--------------------------------------------------------------------------------
1 | module Pipes
2 | 
3 | import public Pipes.Core
4 | import public Pipes.Prelude
5 | 
6 | --
7 | 


--------------------------------------------------------------------------------
/src/Pipes/Core.idr:
--------------------------------------------------------------------------------
  1 | module Pipes.Core
  2 | 
  3 | import public Control.Monad.Identity
  4 | import public Control.Monad.Trans
  5 | 
  6 | 
  7 | ||| Main data type for Pipes:
  8 | ||| * `a` is the type flowing in from the upstream
  9 | ||| * `b` is the type flowing out to downstream
 10 | ||| * `m` is the Monad the pipe runs in
 11 | ||| * `r2` is the returned value of the pipe
 12 | ||| * `r1` is the returned value of the previous pipe
 13 | 
 14 | export
 15 | data PipeM : (a, b, r1 : Type) -> (m : Type -> Type) -> (r2 : Type) -> Type where
 16 |   Pure    : r2 -> PipeM a b r1 m r2                                       -- Lift a value into the pipe
 17 |   Action  : m (Inf (PipeM a b r1 m r2)) -> PipeM a b r1 m r2              -- Interleave an effect
 18 |   Yield   : Inf (PipeM a b r1 m r2) -> m () -> b -> PipeM a b r1 m r2     -- Yield a value and next status
 19 |   Await   : (Either r1 a -> Inf (PipeM a b r1 m r2)) -> PipeM a b r1 m r2 -- Yield a continuation (expecting a value)
 20 | 
 21 | ||| `yield` sends a value downstream
 22 | 
 23 | export
 24 | yield : (Monad m) => b -> PipeM a b r' m ()
 25 | yield = Yield (Pure ()) (pure ())
 26 | 
 27 | ||| `finalizeOr` sends a value downstream, or
 28 | ||| run the finalizer if the downstream pipe is termination
 29 | 
 30 | export
 31 | yieldOr : (Monad m) => b -> m () -> PipeM a b r' m ()
 32 | yieldOr value finalize = Yield (Pure ()) finalize value
 33 | 
 34 | ||| `await` waits from an upstream value
 35 | 
 36 | export
 37 | await : PipeM a b r' m (Maybe a)
 38 | await = Await $ \v =>
 39 |   case v of Right x => Pure (Just x)
 40 |             _ => Pure (the (Maybe a) Nothing)
 41 | 
 42 | ||| `awaitOr` waits from an upstream value, or result of upstream pipe
 43 | 
 44 | export
 45 | awaitOr : PipeM a b r1 m (Either r1 a)
 46 | awaitOr = Await $ \v => Pure v
 47 | 
 48 | ||| A `Source` cannot `await` any input
 49 | 
 50 | public export
 51 | Source : (m: Type -> Type) -> (b: Type) -> Type
 52 | Source m b = PipeM Void b Void m ()
 53 | 
 54 | ||| A `Source` that can return a result of type `r`
 55 | 
 56 | public export
 57 | SourceM : (b: Type) -> (m: Type -> Type) -> (r: Type) -> Type
 58 | SourceM b m r = PipeM Void b Void m r
 59 | 
 60 | ||| A `Pipe` can `await` and `yield`
 61 | 
 62 | public export
 63 | Pipe : {r: Type} -> (a: Type) -> (m: Type -> Type) -> (b: Type) -> Type
 64 | Pipe {r} a m b = PipeM a b r m r
 65 | 
 66 | ||| A `Sink` cannot `yield` anything
 67 | 
 68 | public export
 69 | Sink : {r1: Type} -> (a: Type) -> (m: Type -> Type) -> (r: Type) -> Type
 70 | Sink {r1} a m r = PipeM a Void r1 m r
 71 | 
 72 | ||| A `Sink` with access to the previous pipe return value
 73 | 
 74 | public export
 75 | SinkM : (a: Type) -> (m: Type -> Type) -> (r1, r2: Type) -> Type
 76 | SinkM a m r1 r2 = PipeM a Void r1 m r2
 77 | 
 78 | ||| An `Effect` cannot `await` or `yield` (pure effect)
 79 | 
 80 | public export
 81 | Effect : (m: Type -> Type) -> (r: Type) -> Type
 82 | Effect m r = PipeM Void Void Void m r
 83 | 
 84 | ||| Functor implementation: (Recursively replace `r` with `f r`)
 85 | 
 86 | export
 87 | implementation (Monad m) => Functor (PipeM a b r1 m) where
 88 |   map f = assert_total recur where
 89 |     recur (Pure r) = Pure (f r)
 90 |     recur (Action a) = Action (a >>= \x => pure (recur x))
 91 |     recur (Yield next finish b) = Yield (recur next) finish b
 92 |     recur (Await cont) = Await (\x => recur (cont x))
 93 | 
 94 | ||| Applicative implementation (Recursively replace `r` with `map r pa`)
 95 | 
 96 | export
 97 | implementation (Monad m) => Applicative (PipeM a b r1 m) where
 98 |   pure = Pure
 99 |   pf <*> pa = assert_total (recur pf) where
100 |     recur (Pure f) = map f pa
101 |     recur (Action a) = Action (a >>= \x => pure (recur x))
102 |     recur (Yield next finish b) = Yield (recur next) finish b
103 |     recur (Await cont) = Await (\x => recur (cont x))
104 | 
105 | ||| Monad implementation (Recursively replace `r` with `f r`)
106 | 
107 | export
108 | implementation (Monad m) => Monad (PipeM a b r1 m) where
109 |   m >>= f = assert_total (recur m) where
110 |     recur (Pure r) = f r
111 |     recur (Action a) = Action (a >>= \x => pure (recur x))
112 |     recur (Yield next finish b) = Yield (recur next) finish b
113 |     recur (Await cont) = Await (\x => recur (cont x))
114 | 
115 | ||| Monad Transformer implementation
116 | ||| * Wrap the monadic action in a `Action` constructor
117 | ||| * Wrap the monadic return in a `Pure` constructor
118 | 
119 | export
120 | implementation MonadTrans (PipeM a b r1) where
121 |   lift m = assert_total $ Action (m >>= \x => pure (Pure x))
122 | 
123 | infixr 9 .|
124 | 
125 | ||| Assembling pipes: Pull based behavior
126 | ||| * Run the actions of the right pipe until it reaches `await`
127 | ||| * The run the actions of the left pipe until it reached `yield`
128 | 
129 | export
130 | (.|) : (Monad m) => PipeM a b r1 m r2 -> PipeM b c r2 m r3 -> PipeM a c r1 m r3
131 | (.|) = pull (pure ()) where
132 |   mutual
133 | 
134 |     pull : (Monad m) => m () -> PipeM a b r1 m r2 -> PipeM b c r2 m r3 -> PipeM a c r1 m r3
135 |     pull final up (Yield next finish c) =
136 |       let final' = do finish; final
137 |       in Yield (pull final up next) final' c      -- Yielding downstream
138 |     pull final up (Action a) =
139 |       lift a >>= \next => pull final up next      -- Produce effect downstream
140 |     pull final up (Await cont) =
141 |       up `push` \x => cont x                      -- Ask upstream for a value
142 |     pull final up (Pure r) =
143 |       do lift final; Pure r
144 | 
145 |     push : (Monad m) => PipeM a b r1 m r2 -> (Either r2 b -> PipeM b c r2 m r3) -> PipeM a c r1 m r3
146 |     push (Await cont) down =
147 |       Await (\a => cont a `push` down)            -- Awaiting upstream
148 |     push (Action a) down =
149 |       lift a >>= \next => next `push` down        -- Produce effect upstream
150 |     push (Yield next finish b) down =
151 |       pull finish next (down (Right b))           -- Give control downstream
152 |     push (Pure r) down =
153 |       pull (pure ()) (Pure r) (down (Left r))     -- Termination, send Nothing to next
154 | 
155 | 
156 | ||| Run an Effect and collect the output
157 | ||| * Execute the sequence of effects of the pipe
158 | ||| * Return the final value when no effects are remaining
159 | 
160 | export
161 | runPipe : (Monad m) => Effect m r -> m r
162 | runPipe (Pure r) = pure r                         -- Done executing the pipe, return the result
163 | runPipe (Action a) = a >>= \p => runPipe p        -- Execute the action, run the next of the pipe
164 | runPipe (Yield next finish b) = absurd b
165 | runPipe (Await cont) = runPipe $ Await (either absurd absurd)
166 | 
167 | ||| Run an Effect and discard the output
168 | 
169 | export
170 | runEffect : (Monad m) => Effect m r -> m ()
171 | runEffect p = runPipe p *> pure ()
172 | 
173 | ||| Run an pure Effect in the Identity Monad
174 | 
175 | export
176 | runPure : Effect Identity r -> r
177 | runPure = runIdentity . runPipe
178 | 
179 | ||| `foldM` consumes a stream
180 | ||| It creates a Sink to fold a set of values into a single output value
181 | 
182 | export
183 | foldM : (Monad m) => (a -> b -> m b) -> b -> Sink a m b
184 | foldM f = recur where
185 |   recur acc = do
186 |     ma <- await
187 |     case ma of
188 |       Just x => lift (f x acc) >>= recur
189 |       Nothing => pure acc
190 | 
191 | export
192 | fold : (Monad m) => (a -> b -> b) -> b -> Sink a m b
193 | fold f = foldM (\a, b => pure (f a b))
194 | 
195 | ||| `idP` is the identity Pipe
196 | 
197 | export
198 | idP : (Monad m) => Pipe a m a
199 | idP = awaitOr >>= either Pure (Yield idP (pure ()))
200 | 
201 | ||| The function `each` lifts a foldable to a Source
202 | ||| * The actual type is in fact more general
203 | ||| * It allows you to use it to build pipes
204 | 
205 | export
206 | each : (Monad m, Foldable f) => f a -> PipeM a' a r m ()
207 | each xs = foldr (\x, p => yield x *> p) (pure ()) xs
208 | 
209 | ||| Use `awaitOne` to automatically take care of forwarding the return value
210 | ||| of the previous pipe to the next pipe
211 | 
212 | export
213 | awaitOne : (Monad m) => (i -> PipeM i o r m r) -> PipeM i o r m r
214 | awaitOne f = awaitOr >>= either Pure f
215 | 
216 | ||| Use `awaitForever` to build stateless pipes
217 | 
218 | export
219 | awaitForever : (Monad m) => (i -> PipeM i o r m r') -> PipeM i o r m r
220 | awaitForever f = recur where
221 |   recur = awaitOr >>= either Pure (\x => do f x; recur)
222 | 
223 | --
224 | 


--------------------------------------------------------------------------------
/src/Pipes/Prelude.idr:
--------------------------------------------------------------------------------
  1 | module Pipes.Prelude
  2 | 
  3 | import Control.Monad.Trans
  4 | import Pipes.Core
  5 | 
  6 | %access export
  7 | 
  8 | -- Helper functions to construct Sources more easily
  9 | -- * `stdinLn` lifts the standard output to a Source
 10 | -- * `iterating` creates an infinite series of value f(f(f(f(...))))
 11 | -- * `unfolding` creates a possibly infinite series of value from a seed
 12 | 
 13 | stdinLn : String -> Source IO String
 14 | stdinLn promptLine = recur where
 15 |   recur = do
 16 |     lift (putStr promptLine)
 17 |     lift getLine >>= yield
 18 |     recur
 19 | 
 20 | streamFile : File -> Source IO (Either FileError String)
 21 | streamFile f = recur f where
 22 |   recur f = do
 23 |     end <- lift (fEOF f)
 24 |     if end
 25 |       then lift (closeFile f)
 26 |       else do
 27 |         l <- lift (fGetLine f)
 28 |         yieldOr l (closeFile f)
 29 |         recur f
 30 | 
 31 | readFile : String -> Source IO (Either FileError String)
 32 | readFile fileName = do
 33 |   Right f <- lift (openFile fileName Read)
 34 |     | Left err => yield (Left err)
 35 |   streamFile f
 36 | 
 37 | iterating : (Monad m) => (a -> a) -> a -> Source m a
 38 | iterating f = recur where
 39 |   recur a = do
 40 |     yield a
 41 |     recur (f a)
 42 | 
 43 | unfolding : (Monad m) => (seed -> Maybe (a, seed)) -> seed -> Source m a
 44 | unfolding f = recur . f where
 45 |   recur Nothing = pure ()
 46 |   recur (Just (a, seed)) = do
 47 |     yield a
 48 |     recur (f seed)
 49 | 
 50 | replicating : (Monad m) => Nat -> a -> Source m a
 51 | replicating times x = recur times where
 52 |   recur Z = pure ()
 53 |   recur (S n) = do yield x; recur n
 54 | 
 55 | -- Helper functions to construct pipes more easily
 56 | -- * `mapping` lifts a function as a pipe transformation
 57 | -- * `filtering` lifts a predicate into a pipe filter
 58 | -- * `takingWhile` lifts a predicate into a pipe breaker
 59 | -- * `droppingWhile` lifts a predicate into a pipe delayed starter
 60 | 
 61 | mapping : (Monad m) => (a -> b) -> Pipe a m b
 62 | mapping f = awaitForever (yield . f)
 63 | 
 64 | mappingM : (Monad m) => (a -> m b) -> Pipe a m b
 65 | mappingM f = awaitForever $ \x => lift (f x) >>= yield
 66 | 
 67 | concatting : (Monad m, Foldable f) => Pipe (f a) m a
 68 | concatting = awaitForever each
 69 | 
 70 | concatMapping : (Monad m, Foldable f) => (a -> f b) -> Pipe a m b
 71 | concatMapping f = mapping f .| concatting
 72 | 
 73 | filtering : (Monad m) => (a -> Bool) -> Pipe a m a
 74 | filtering p = awaitForever $ \x => if p x then yield x else pure ()
 75 | 
 76 | filteringJust : (Monad m) => Pipe (Maybe a) m a
 77 | filteringJust = awaitForever $ maybe (pure ()) yield
 78 | 
 79 | taking : (Monad m) => Nat -> PipeM a a r m (Maybe r)
 80 | taking = recur where
 81 |   recur Z = pure Nothing
 82 |   recur (S n) = do
 83 |     x <- awaitOr
 84 |     case x of
 85 |       Left r => pure (Just r)
 86 |       Right x => do yield x; taking n
 87 | 
 88 | dropping : (Monad m) => Nat -> Pipe a m a
 89 | dropping Z = idP
 90 | dropping (S n) = awaitOne $ \x => dropping n
 91 | 
 92 | takingWhile : (Monad m) => (a -> Bool) -> PipeM a a r m (Maybe r)
 93 | takingWhile p = recur where
 94 |   recur = do
 95 |     mx <- awaitOr
 96 |     case mx of
 97 |       Left r => pure (Just r)
 98 |       Right x => if p x
 99 |         then do yield x; recur
100 |         else pure Nothing
101 | 
102 | droppingWhile : (Monad m) => (a -> Bool) -> Pipe a m a
103 | droppingWhile p = recur where
104 |   recur = awaitOne $ \x =>
105 |     if p x
106 |       then recur
107 |       else do yield x; idP
108 | 
109 | deduplicating : (Eq a, Monad m) => Pipe a m a
110 | deduplicating = recur (the (a -> Bool) (const True)) where
111 |   recur isDifferent =
112 |     awaitOne $ \x => do
113 |       when (isDifferent x) (yield x)
114 |       recur (/= x)
115 | 
116 | repeating : (Monad m) => Nat -> Pipe a m a
117 | repeating n = awaitForever $ \x => sequence_ (replicate n (yield x))
118 | 
119 | tracing : (Monad m) => (a -> m b) -> Pipe a m a
120 | tracing trace = mappingM (\x => trace x *> pure x)
121 | 
122 | groupingBy : (Monad m) => (a -> a -> Bool) -> Pipe a m (List a)
123 | groupingBy sameGroup = recur (the (List a) []) where
124 |   recur xs = do
125 |     mx <- awaitOr
126 |     case mx of
127 |       Left r => do
128 |         when (length xs > 0) (yield (reverse xs))
129 |         pure r
130 |       Right y => do
131 |         case xs of
132 |           [] => recur [y]
133 |           (x::_) =>
134 |             if sameGroup x y
135 |                 then recur (y::xs)
136 |                 else do
137 |                   yield (reverse xs)
138 |                   recur [y]
139 | 
140 | grouping : (Monad m, Eq a) => Pipe a m (List a)
141 | grouping = groupingBy (==)
142 | 
143 | chunking : (Monad m) => (n: Nat) -> {auto prf: GTE n 0} -> Pipe a m (List a)
144 | chunking chunkSize = recur (the (List a -> List a) id) chunkSize where
145 |   recur diffList Z = do
146 |     yield (diffList [])
147 |     recur id chunkSize
148 |   recur diffList (S n) = do
149 |     x <- awaitOr
150 |     case x of
151 |       Left r => do yield (diffList []); pure r
152 |       Right x => recur (diffList . (x ::)) n
153 | 
154 | splittingBy : (Monad m) => (a -> Bool) -> Pipe a m (List a)
155 | splittingBy p = recur (the (List a) []) where
156 |   recur xs = do
157 |     x <- awaitOr
158 |     case x of
159 |       Left r => do yield (reverse xs); pure r
160 |       Right x => if p x
161 |         then do yield (reverse xs); recur []
162 |         else recur (x :: xs)
163 | 
164 | scanning : (Monad m) => (a -> b -> b) -> b -> Pipe a m b
165 | scanning f initial = do
166 |     yield initial
167 |     recur initial
168 |   where
169 |     recur acc = awaitOne $ \x => do
170 |       let acc' = f x acc
171 |       yield acc'
172 |       recur acc'
173 | 
174 | 
175 | -- Helper functions to construct Sinks more easily
176 | -- * `stdoutLn` lifts the standard output to a Sink
177 | -- * `discard` consumes all outputs and ignore them
178 | 
179 | discard : (Monad m) => SinkM a m r r
180 | discard = awaitForever $ \_ => pure ()
181 | 
182 | stdoutLn : SinkM String IO r r
183 | stdoutLn = tracing putStrLn .| discard
184 | 
185 | summing : (Monad m, Num a) => Sink a m a
186 | summing = fold (+) 0
187 | 
188 | multiplying : (Monad m, Num a) => Sink a m a
189 | multiplying = fold (*) 1
190 | 
191 | consuming : (Monad m) => Sink a m (List a)
192 | consuming = recur (the (List a -> List a) id) where
193 |   recur diffList = do
194 |     mx <- await
195 |     case mx of
196 |       Just x => recur (diffList . (x ::))
197 |       Nothing => pure (diffList [])
198 | 
199 | --
200 | 


--------------------------------------------------------------------------------
/tests/Main.idr:
--------------------------------------------------------------------------------
1 | module Main
2 | 
3 | import Test.Pipes
4 | 
5 | export
6 | main : IO ()
7 | main = run_tests
8 | 


--------------------------------------------------------------------------------
/tests/Test/Pipes.idr:
--------------------------------------------------------------------------------
  1 | module Test.Pipes
  2 | 
  3 | import Control.Monad.Writer
  4 | import Pipes
  5 | import Test.Utils
  6 | 
  7 | %access export
  8 | 
  9 | 
 10 | --------------------------------------------------------------------------------
 11 | -- Pure pipelines
 12 | --------------------------------------------------------------------------------
 13 | 
 14 | even : Int -> Bool
 15 | even n = mod n 2 == 0
 16 | 
 17 | test_filtering_mapping : Test
 18 | test_filtering_mapping = do
 19 |   let ints = each [1..10] .| filtering even .| mapping (*2)
 20 |   assertEq 60 $ runPure (ints .| summing)
 21 |   assertEq 122880 $ runPure (ints .| multiplying)
 22 | 
 23 | test_iterating_take : Test
 24 | test_iterating_take = do
 25 |   assertEq 55 $ runPure $ iterating (+1) 1 .| taking 10 .| summing
 26 |   assertEq 55 $ runPure $ iterating (+1) 1 .| takingWhile (< 11) .| summing
 27 | 
 28 | test_unfolding_drop : Test
 29 | test_unfolding_drop = do
 30 |   let source = unfolding (\x => Just (x, x + 1)) (-9)
 31 |   assertEq 55 $ runPure $ source .| dropping 10 .| taking 10 .| summing
 32 |   assertEq 55 $ runPure $ source .| droppingWhile (< 1) .| taking 10 .| summing
 33 | 
 34 | test_repeating_deduplicating : Test
 35 | test_repeating_deduplicating = do
 36 |   assertEq 110 $ runPure $ each [1..10] .| repeating 2 .| summing
 37 |   assertEq 55 $ runPure $ each [1..10] .| repeating 2 .| deduplicating .| summing
 38 | 
 39 | test_concatMapping : Test
 40 | test_concatMapping = do
 41 |   assertEq 110 $ runPure $ each [1..10] .| concatMapping (\x => [x, x]) .| summing
 42 | 
 43 | test_grouping : Test
 44 | test_grouping = do
 45 |   assertEq [2, 4, 6, 8, 10] $
 46 |     runPure (each [1..5] .| repeating 2 .| grouping .| mapping sum .| consuming)
 47 | 
 48 | test_chunking : Test
 49 | test_chunking = do
 50 |   assertEq [[1, 2], [3, 4], [5]] $
 51 |     runPure (each [1..5] .| chunking 2 .| consuming)
 52 | 
 53 | test_splitting : Test
 54 | test_splitting = do
 55 |   assertEq [[1], [3], [5]] $
 56 |     runPure (each [1..5] .| splittingBy even .| consuming)
 57 | 
 58 | test_replicating_scanning : Test
 59 | test_replicating_scanning = do
 60 |   assertEq [0..10] $
 61 |     runPure (replicating 10 1 .| scanning (+) 0 .| consuming)
 62 | 
 63 | 
 64 | --------------------------------------------------------------------------------
 65 | -- Effectful pipes
 66 | --------------------------------------------------------------------------------
 67 | 
 68 | test_tracing : Test
 69 | test_tracing = do
 70 |   (a, w) <- runWriterT $ runPipe (each [1..10] .| tracing (tell . show) .| discard)
 71 |   assertEq "12345678910" w
 72 | 
 73 | rightOr : r -> Either l r -> r
 74 | rightOr r (Left _) = r
 75 | rightOr _ (Right r) = r
 76 | 
 77 | test_reading_file : Test
 78 | test_reading_file = do
 79 |   r <- runPipe (readFile "./Test/test.txt" .| mapping (rightOr "") .| consuming)
 80 |   assertEq "123\n45678\n9\n" (concat r)
 81 | 
 82 | earlyTerminating : MonadWriter String m => Source m String
 83 | earlyTerminating = do
 84 |   yieldOr "." (tell "done")
 85 |   earlyTerminating
 86 | 
 87 | test_early_termination : Test
 88 | test_early_termination = do
 89 |   (a, w) <- runWriterT $ runPipe (earlyTerminating .| taking 10 .| discard)
 90 |   assertEq "done" w
 91 | 
 92 | --------------------------------------------------------------------------------
 93 | -- All tests
 94 | --------------------------------------------------------------------------------
 95 | 
 96 | run_tests : IO ()
 97 | run_tests = runTestSuite
 98 |     [ test_filtering_mapping
 99 |     , test_iterating_take
100 |     , test_unfolding_drop
101 |     , test_repeating_deduplicating
102 |     , test_concatMapping
103 |     , test_grouping
104 |     , test_chunking
105 |     , test_splitting
106 |     , test_replicating_scanning
107 |     , test_tracing
108 |     , test_reading_file
109 |     , test_early_termination
110 |     ]
111 | 
112 | --
113 | 


--------------------------------------------------------------------------------
/tests/Test/Tutorial.idr:
--------------------------------------------------------------------------------
 1 | module Test.Tutorial
 2 | 
 3 | import Pipes
 4 | import Test.Pipes
 5 | 
 6 | 
 7 | --------------------------------------------------------------------------------
 8 | -- A simple echo program
 9 | --------------------------------------------------------------------------------
10 | 
11 | echo_setup : IO ()
12 | echo_setup = disableBuffering
13 | 
14 | echo_bad : IO ()
15 | echo_bad = do
16 |   putStr "in> "
17 |   l <- getLine                  -- Read the standard input
18 |   when (l /= "quit") $ do       -- Stop upon encountering "quit"
19 |     putStrLn ("out> " ++ l)     -- Echo the string in standard output
20 |     echo_bad
21 | 
22 | echo_good : IO ()
23 | echo_good = runEffect $
24 |   stdinLn "in> "                -- Read the standard input
25 |     .| takingWhile (/= "quit")  -- Stop upon encountering "quit"
26 |     .| mapping ("out> " ++)     -- Add the prompt to the string
27 |     .| stdoutLn                 -- Echo the string in standard output
28 | 
29 | 
30 | -- Slight modification to the program:
31 | -- * Do not repeat the same sentence twice
32 | -- * See how it gets bad on the loop side
33 | 
34 | echo_once_bad : IO ()
35 | echo_once_bad = loop (const True) where
36 |   loop : (String -> Bool) -> IO ()
37 |   loop isDifferent = do
38 |     putStr "in> "
39 |     l <- getLine                  -- Read the standard input
40 |     when (l /= "quit") $ do       -- Stop upon encountering "quit"
41 |       when (isDifferent l) $      -- Remove consecutive repeating calls
42 |         putStrLn ("out> " ++ l)   -- Echo the string in standard output
43 |       loop (/= l)                 -- Loop with last read string
44 | 
45 | echo_once_good : IO ()
46 | echo_once_good = runEffect $
47 |   stdinLn "in> "                -- Read the standard input
48 |     .| takingWhile (/= "quit")  -- Stop upon encountering "quit"
49 |     .| deduplicating            -- Remove consecutive repeating calls
50 |     .| mapping ("out> " ++)     -- Add the prompt to the string
51 |     .| stdoutLn                 -- Echo the string in standard output
52 | 
53 | 
54 | --------------------------------------------------------------------------------
55 | -- Just exploiting laziness
56 | --------------------------------------------------------------------------------
57 | 
58 | sum_with_traces : IO ()
59 | sum_with_traces = do
60 |   r <- runPipe $ each [1..10] .| tracing printLn .| fold (+) 0
61 |   printLn r
62 | 
63 | sum_with_limit : IO ()
64 | sum_with_limit = do
65 |   r <- runPipe $ each [1..10] .| tracing printLn .| takingWhile (< 5) .| tracing printLn .| fold (+) 0
66 |   printLn r
67 | 
68 | 
69 | --------------------------------------------------------------------------------
70 | 
71 | export
72 | run_tutotial : IO ()
73 | run_tutotial = do
74 |   -- echo_example
75 |   sum_with_traces
76 |   sum_with_limit
77 | 


--------------------------------------------------------------------------------
/tests/Test/Utils.idr:
--------------------------------------------------------------------------------
 1 | module Test.Utils
 2 | 
 3 | import System
 4 | 
 5 | public export
 6 | Test : Type
 7 | Test = IO Int
 8 | 
 9 | export
10 | assertThat : Bool -> String -> Test
11 | assertThat test errorMsg =
12 |   if test
13 |     then do putStrLn "Test Passed"; pure 0
14 |     else do putStrLn ("Test Failed: " ++ errorMsg); pure 1
15 | 
16 | export
17 | assertEq : (Eq a, Show a) => (expected : a) -> (given : a) -> Test
18 | assertEq e g =
19 |   assertThat (g == e) $
20 |     "Expected == " ++ show e ++ ", Got: " ++ show g
21 | 
22 | export
23 | runTests : List Test -> Test
24 | runTests = foldl (\res, t => (+) <$> res <*> t) (pure 0)
25 | 
26 | export
27 | runTestSuite : List Test -> IO ()
28 | runTestSuite tests = do
29 |   failedCount <- runTests tests
30 |   if failedCount > 0
31 |     then exitFailure
32 |     else pure ()
33 | 
34 | --
35 | 


--------------------------------------------------------------------------------
/tests/Test/test.txt:
--------------------------------------------------------------------------------
1 | 123
2 | 45678
3 | 9
4 | 


--------------------------------------------------------------------------------
/tests/test.ipkg:
--------------------------------------------------------------------------------
 1 | package test
 2 | 
 3 | opts = "--sourcepath ../src --idrispath ../src"
 4 | 
 5 | main = Main
 6 | 
 7 | modules = Test.Pipes
 8 |         , Test.Tutorial
 9 |         , Test.Utils
10 | 
11 | tests = Test.Pipes.run_tests
12 | 


--------------------------------------------------------------------------------
/tests/tests.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | 
3 | idris --build test.ipkg
4 | idris --testpkg test.ipkg
5 | 


--------------------------------------------------------------------------------
/tests/tutorial.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | 
3 | idris --repl test.ipkg
4 | 


--------------------------------------------------------------------------------