├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── quiver.cabal ├── src └── Control │ ├── Quiver.lhs │ └── Quiver │ ├── Internal.lhs │ ├── SP.lhs │ └── Trans.lhs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | *.o 3 | *.hi 4 | *.swp 5 | *~ 6 | 7 | .cabal-sandbox/ 8 | cabal.sandbox.config 9 | dist 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Quiver 3 | ====== 4 | 5 | Copyright © 2015 Patryk Zadarnowski «pat@jantar.org». 6 | All rights reserved. 7 | 8 | Redistribution and use in source and binary forms, with or without 9 | modification, are permitted provided that the following conditions 10 | are met: ➀ Redistributions of source code must retain the above 11 | copyright notice, this list of conditions and the following disclaimer. 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. ➂ The name of any 15 | author may not be used to endorse or promote products derived from this 16 | software without their specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, 19 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY 20 | AND FITNESS FOR A PARTICULAR PURPOSE, ARE DISCLAIMED. IN NO EVENT SHALL 21 | THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 22 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 23 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA OR PROFITS; 24 | OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 26 | OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 27 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Quiver 2 | ====== 3 | 4 | Copyright © 2015 Patryk Zadarnowski «pat@jantar.org». 5 | All rights reserved. 6 | 7 | _Quiver_ is a powerful stream processing library for 8 | combinatorial and monadic representation of computations 9 | over both inductive and coinductive data streams. 10 | 11 | It is similar to Gabriel Gonzalez's _pipes_ and 12 | Michael Snoyman's _conduit_, but generalises both 13 | with support for functor-based computations and 14 | a clean support for finite (i.e., inductive) data 15 | streams, both upstream and downstream of the computation 16 | being defined. 17 | 18 | The underlying data structure, `P`, is almost identical 19 | to the `Proxy` data structure of the `Pipes` library, 20 | except that the `Consume` and `Produce` constructors 21 | (corresponding, respectively, to `Request` and `Response` 22 | in the Pipes' `Proxy` data type) include an additional 23 | argument which explicitly captures the processor's 24 | behaviour in the event of input stream depletion 25 | (for `Consume`) or output decoupling (for `Produce`). 26 | This simple mechanism subsumes Conduit's need for 27 | elaborate unconsumed-input tracking mechanisms, 28 | and allows us to provide a mathematically-clean 29 | framework for processing of finite data streams. 30 | 31 | This library is currently very young, and users should 32 | expect significant changes to the Quiver core combinators 33 | as the underlying theory is developed and the interface 34 | stabilises asymptotically to the future version 1.0. 35 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | import Distribution.Simple 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /quiver.cabal: -------------------------------------------------------------------------------- 1 | name: quiver 2 | version: 1.1.3 3 | synopsis: Quiver finite stream processing library 4 | homepage: https://github.com/zadarnowski/quiver 5 | category: Control 6 | stability: alpha 7 | 8 | author: Patryk Zadarnowski 9 | maintainer: Patryk Zadarnowski 10 | 11 | copyright: Copyright (c) 2015 Patryk Zadarnowski 12 | 13 | description: /Quiver/ is a powerful stream processing library for 14 | combinatorial and monadic representation of computations 15 | over both inductive and coinductive data streams. 16 | . 17 | It is similar to Gabriel Gonzalez's /pipes/ and 18 | Michael Snoyman's /conduit/, but generalises both 19 | with support for functor-based computations and 20 | a clean support for finite (i.e., inductive) data 21 | streams, both upstream and downstream of the computation 22 | being defined. 23 | 24 | cabal-version: >= 1.18 25 | build-type: Simple 26 | license: BSD3 27 | license-file: LICENSE 28 | extra-source-files: README.md 29 | 30 | source-repository head 31 | type: git 32 | location: https://github.com/zadarnowski/quiver.git 33 | 34 | source-repository this 35 | type: git 36 | location: https://github.com/zadarnowski/quiver.git 37 | tag: 1.1.2 38 | 39 | library 40 | hs-source-dirs: src 41 | default-language: Haskell2010 42 | ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-missing-signatures 43 | exposed-modules: Control.Quiver 44 | Control.Quiver.Internal 45 | Control.Quiver.SP 46 | Control.Quiver.Trans 47 | build-depends: base >= 4.8 && < 5, 48 | mmorph >= 1.0.4, 49 | transformers >= 0.4.2.0 50 | -------------------------------------------------------------------------------- /src/Control/Quiver.lhs: -------------------------------------------------------------------------------- 1 | > -- | Module: Control.Quiver 2 | > -- Description: Core Quiver definitions 3 | > -- Copyright: © 2015 Patryk Zadarnowski 4 | > -- License: BSD3 5 | > -- Maintainer: pat@jantar.org 6 | > -- Stability: experimental 7 | > -- Portability: portable 8 | > -- 9 | > -- This module provides the core types and combinators 10 | > -- of the Quiver stream processing library. 11 | 12 | > {-# LANGUAGE RankNTypes, TupleSections #-} 13 | 14 | > module Control.Quiver ( 15 | > -- Imported from @Control.Quiver.Internal@: 16 | > P, Consumer, Producer, Effect, 17 | > consume, produce, enclose, deliver, 18 | > decouple, deplete, 19 | > -- Defined below: 20 | > fetch, fetch_, 21 | > emit, emit_, 22 | > qlift, qhoist, qembed, 23 | > qpure, qid, qconcat, qtraverse, 24 | > runEffect, 25 | > (>>->), (>->>), (+>>->), (>>->+), (+>->>), (>->>+), (>&>), 26 | > qcompose, 27 | > ) where 28 | 29 | > import Control.Quiver.Internal 30 | 31 | > infixl 1 >>->, >->>, +>>->, >>->+, +>->>, >->>+, >&> 32 | 33 | > -- | @fetch x@ represents a singleton stream processor that 34 | > -- sends the request value @x@ upstream and delivers the 35 | > -- next input value received, or @Nothing@ if the upstream 36 | > -- processor has been depleted. 37 | 38 | > fetch :: Functor f => a -> P a a' b b' f (Maybe a') 39 | > fetch x = consume x (deliver . Just) (deliver Nothing) 40 | 41 | > -- | @fetch_ x@ represents a singleton stream processor that 42 | > -- sends the request value @x@ upstream, discarding any 43 | > -- input received, for symmetry with @emit_@. 44 | 45 | > fetch_ :: a -> P a a' b b' f () 46 | > fetch_ x = consume x (deliver . const ()) (deliver ()) 47 | 48 | > -- | @emit y@ represents a singleton stream processor that 49 | > -- produces a single output value @y@ and delivers the 50 | > -- response received from the downstream processor, or 51 | > -- @Nothing@ if the downstream processor has been decoupled. 52 | 53 | > emit :: b -> P a a' b b' f (Maybe b') 54 | > emit y = produce y (deliver . Just) (deliver Nothing) 55 | 56 | > -- | @emit_ y@ represents a singleton stream processor that 57 | > -- produces a single output value @y@, ignoring any response 58 | > -- received from the downstream processor. 59 | 60 | > emit_ :: b -> P a a' b b' f () 61 | > emit_ y = produce y (deliver . const ()) (deliver ()) 62 | 63 | > -- | @qpure g f z@ produces an infinite consumer/producer that 64 | > -- uses a pure function @f@ to convert every input value into 65 | > -- an output, and @g@ to convert each downstream response value 66 | > -- into an upstream request; the initial request is obtained 67 | > -- by applying @g@ to the initial response value @z@. 68 | 69 | > qpure :: (b' -> a) -> (a' -> b) -> b' -> P a a' b b' f (Either a b) 70 | > qpure g f = cloop 71 | > where 72 | > cloop y = let y' = g y in consume y' ploop (deliver (Left y')) 73 | > ploop x = let x' = f x in produce x' cloop (deliver (Right x')) 74 | 75 | > -- | A pull-based identity processor, equivalent to 'qpure id id'. 76 | 77 | > qid :: b -> P b a a b f () 78 | > qid = cloop 79 | > where 80 | > cloop z = consume z ploop (deliver ()) 81 | > ploop x = produce x cloop (deliver ()) 82 | 83 | > -- | A pull-based list flattening processor, delivering the list 84 | > -- of inputs that could not be produced and a list of responses 85 | > -- that could not be consumed. 86 | 87 | > qconcat :: [b] -> P [b] [a] a b f ([a], [b]) 88 | > qconcat = cloop 89 | > where 90 | > cloop ys = consume ys (ploop []) (deliver ([], [])) 91 | > ploop ys (x:xs) = produce x (\y -> ploop (y:ys) xs) (deliver (xs, reverse ys)) 92 | > ploop ys [] = cloop (reverse ys) 93 | 94 | > -- | @qtraverse g f z@ produces an infinite consumer/producer that 95 | > -- uses a functor @f@ to convert every input value into 96 | > -- an output, and @g@ to convert each downstream response value 97 | > -- into an upstream request; the initial request is obtained 98 | > -- by applying @g@ to the initial response value @z@. 99 | 100 | > qtraverse :: Functor f => (b' -> f a) -> (a' -> f b) -> b' -> P a a' b b' f (Either a b) 101 | > qtraverse g f = cloop 102 | > where 103 | > cloop y = enclose (fmap (\y' -> consume y' ploop (deliver (Left y'))) (g y)) 104 | > ploop x = enclose (fmap (\x' -> produce x' cloop (deliver (Right x'))) (f x)) 105 | 106 | > -- | Evaluates an /effect/, i.e., a processor that is both detached 107 | > -- and depleted and hence neither consumes nor produces any input, 108 | > -- returning its delivered value. The base functor must be a monad. 109 | 110 | > runEffect :: Monad f => Effect f r -> f r 111 | > runEffect p = loop p 112 | > where 113 | > loop (Consume _ _ q) = loop q 114 | > loop (Produce _ _ q) = loop q 115 | > loop (Enclose f) = f >>= loop 116 | > loop (Deliver r) = return r 117 | 118 | > -- | The @>>->@ represents a push-based composition of stream processors. 119 | > -- @p1 >>-> p2@ represents a stream processor that forwards the output 120 | > -- of @p1@ to @p2@, delivering the result of both processors. 121 | > -- The new processor is /driven/ by @p2@, so, if the base functor 122 | > -- represents a non-commutative monad, any effects of @p2@ will be 123 | > -- observed before those of @p1@. 124 | 125 | > (>>->) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (r1, r2) 126 | > (Consume x1 k1 q1) >>-> p2 = consume x1 ((>>-> p2) . k1) (q1 >>-> p2) 127 | > (Produce y1 k1 q1) >>-> p2 = loop p2 128 | > where 129 | > loop (Consume x2 k2 _) = k1 x2 >>-> k2 y1 130 | > loop (Produce y2 k2 q2) = produce y2 (loop . k2) (deplete $ loop q2) 131 | > loop (Enclose f2) = enclose (fmap loop f2) 132 | > loop (Deliver r2) = fmap (, r2) q1 133 | > (Enclose f1) >>-> p2 = enclose (fmap (>>-> p2) f1) 134 | > (Deliver r1) >>-> p2 = fmap (r1 ,) (decouple p2) 135 | 136 | > -- | The @+>>->@ represents a pull-based composition of stream processors 137 | > -- that is partial on the left (supply) side, so that @p1 +>>-> p2@ 138 | > -- represents a stream processor that forwards the output of @p1@ to @p2@, 139 | > -- delivering the result of @p2@ and the remainder (unconsumed portion) 140 | > -- of @p1@. The new processor is /driven/ by @p1@, so, if the base functor 141 | > -- represents a non-commutative monad, any effects of @p1@ will be observed 142 | > -- before those of @p2@. 143 | 144 | > (+>>->) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (P a a' b b' f r1, r2) 145 | > (Consume x1 k1 q1) +>>-> p2 = consume x1 ((+>>-> p2) . k1) (decouple $ q1 +>>-> p2) 146 | > (Produce y1 k1 q1) +>>-> p2 = loop p2 147 | > where 148 | > loop (Consume x2 k2 _) = k1 x2 +>>-> k2 y1 149 | > loop (Produce y2 k2 q2) = produce y2 (loop . k2) (deplete $ loop q2) 150 | > loop (Enclose f2) = enclose (fmap loop f2) 151 | > loop (Deliver r2) = deliver (q1, r2) 152 | > (Enclose f1) +>>-> p2 = enclose (fmap (+>>-> p2) f1) 153 | > p1 +>>-> p2 = fmap (p1 ,) (decouple p2) 154 | 155 | > -- | The @>>->+@ represents a pull-based composition of stream processors 156 | > -- that is partial on the right (demand) side, so that @p1 >>->+ p2@ 157 | > -- represents a stream processor that forwards the output of @p1@ to @p2@, 158 | > -- delivering the result of @p1@ and the remainder (unproduced portion) 159 | > -- of @p2@. The new processor is /driven/ by @p1@, so, if the base functor 160 | > -- represents a non-commutative monad, any effects of @p1@ will be observed 161 | > -- before those of @p2@. 162 | 163 | > (>>->+) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (r1, P b' b c c' f r2) 164 | > (Consume x1 k1 q1) >>->+ p2 = consume x1 ((>>->+ p2) . k1) (q1 >>->+ p2) 165 | > (Produce y1 k1 q1) >>->+ p2 = loop p2 166 | > where 167 | > loop (Consume x2 k2 _) = k1 x2 >>->+ k2 y1 168 | > loop (Produce y2 k2 q2) = produce y2 (loop . k2) (deplete $ loop q2) 169 | > loop (Enclose f2) = enclose (fmap loop f2) 170 | > loop p2' = fmap (, p2') q1 171 | > (Enclose f1) >>->+ p2 = enclose (fmap (>>->+ p2) f1) 172 | > (Deliver r1) >>->+ p2 = deliver (r1, p2) 173 | 174 | > -- | The @>->>@ represents a pull-based composition of stream processors. 175 | > -- @p1 >->> p2@ represents a stream processor that forwards the output 176 | > -- of @p1@ to @p2@, delivering the result of both processors. 177 | > -- The new processor is /driven/ by @p2@, so, if the base functor 178 | > -- represents a non-commutative monad, any effects of @p2@ will be 179 | > -- observed before those of @p1@. 180 | 181 | > (>->>) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (r1, r2) 182 | > p1 >->> (Consume x2 k2 q2) = loop p1 183 | > where 184 | > loop (Consume x1 k1 q1) = consume x1 (loop . k1) (decouple $ loop q1) 185 | > loop (Produce y1 k1 _) = k1 x2 >->> k2 y1 186 | > loop (Enclose f1) = enclose (fmap loop f1) 187 | > loop (Deliver r1) = fmap (r1 ,) q2 188 | > p1 >->> (Produce y2 k2 q2) = produce y2 ((p1 >->>) . k2) (p1 >->> q2) 189 | > p1 >->> (Enclose f2) = enclose (fmap (p1 >->>) f2) 190 | > p1 >->> (Deliver r2) = fmap (, r2) (deplete p1) 191 | 192 | > -- | The @+>->>@ represents a pull-based composition of stream processors. 193 | > -- that is partial on the left (supply) side, so that @p1 +>->> p2@ 194 | > -- represents a stream processor that forwards the output of @p1@ to @p2@, 195 | > -- delivering the result of @p2@ and the remainder (unconsumed portion) 196 | > -- of @p1@. The new processor is /driven/ by @p2@, so, if the base functor 197 | > -- represents a non-commutative monad, any effects of @p2@ will be observed 198 | > -- before those of @p1@. 199 | 200 | > (+>->>) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (P a a' b b' f r1, r2) 201 | > p1 +>->> (Consume x2 k2 q2) = loop p1 202 | > where 203 | > loop (Consume x1 k1 q1) = consume x1 (loop . k1) (decouple $ loop q1) 204 | > loop (Produce y1 k1 _) = k1 x2 +>->> k2 y1 205 | > loop (Enclose f1) = enclose (fmap loop f1) 206 | > loop p1' = fmap (p1' ,) q2 207 | > p1 +>->> (Produce y2 k2 q2) = produce y2 ((p1 +>->>) . k2) (p1 +>->> q2) 208 | > p1 +>->> (Enclose f2) = enclose (fmap (p1 +>->>) f2) 209 | > p1 +>->> (Deliver r2) = deliver (p1, r2) 210 | 211 | > -- | The @>>->+@ represents a pull-based composition of stream processors 212 | > -- that is partial on the right (demand) side, so that @p1 >->>+ p2@ 213 | > -- represents a stream processor that forwards the output of @p1@ to @p2@, 214 | > -- delivering the result of @p1@ and the remainder (unproduced portion) 215 | > -- of @p2@. The new processor is /driven/ by @p2@, so, if the base functor 216 | > -- represents a non-commutative monad, any effects of @p2@ will be observed 217 | > -- before those of @p1@. 218 | 219 | > (>->>+) :: Functor f => P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f (r1, P b' b c c' f r2) 220 | > p1 >->>+ (Consume x2 k2 q2) = loop p1 221 | > where 222 | > loop (Consume x1 k1 q1) = consume x1 (loop . k1) (decouple $ loop q1) 223 | > loop (Produce y1 k1 _) = k1 x2 >->>+ k2 y1 224 | > loop (Enclose f1) = enclose (fmap loop f1) 225 | > loop (Deliver r1) = deliver (r1, q2) 226 | > p1 >->>+ (Produce y2 k2 q2) = produce y2 ((p1 >->>+) . k2) (deplete $ p1 >->>+ q2) 227 | > p1 >->>+ (Enclose f2) = enclose (fmap (p1 >->>+) f2) 228 | > p1 >->>+ p2 = fmap (, p2) (deplete p1) 229 | 230 | > -- | An infix version of @flip fmap@ with the same precedence and associativity 231 | > -- as the stream processor composition operators '>->>' and '>>->', indended 232 | > -- for idiomatic processing of composition deliverables using expressions 233 | > -- such as @p >->> q >&> fst@. 234 | 235 | > (>&>) :: Functor f => P a a' b b' f r -> (r -> r') -> P a a' b b' f r' 236 | > (>&>) = flip fmap 237 | 238 | > -- | The @qcompose f p q@ is precisely equivalent to @p >->> q >&> uncurry f@, 239 | > -- but faster. A rewrite rule is included to replace applications of 240 | > -- '>->>' followed by '>&>' into 'qcompose'. 241 | 242 | > qcompose :: Functor f => (r1 -> r2 -> r) -> P a a' b b' f r1 -> P b' b c c' f r2 -> P a a' c c' f r 243 | > qcompose ff p1 (Consume x2 k2 q2) = loop p1 244 | > where 245 | > loop (Consume x1 k1 q1) = consume x1 (loop . k1) (loop' q1) 246 | > loop (Produce y1 k1 _) = qcompose ff (k1 x2) (k2 y1) 247 | > loop (Enclose f1) = enclose (fmap loop f1) 248 | > loop (Deliver r1) = fmap (ff r1) q2 249 | > loop' (Consume _ _ q1) = loop' q1 250 | > loop' (Produce y1 k1 _) = qcompose ff (k1 x2) (k2 y1) 251 | > loop' (Enclose f1) = enclose (fmap loop' f1) 252 | > loop' (Deliver r1) = fmap (ff r1) q2 253 | > qcompose ff p1 (Produce y2 k2 q2) = produce y2 ((qcompose ff p1) . k2) (qcompose ff p1 q2) 254 | > qcompose ff p1 (Enclose f2) = enclose (fmap (qcompose ff p1) f2) 255 | > qcompose ff p1 (Deliver r2) = fmap (flip ff r2) (deplete p1) 256 | 257 | > {-# RULES "qcompose/fmap" forall p q f . fmap f (p >->> q) = qcompose (curry f) p q #-} 258 | -------------------------------------------------------------------------------- /src/Control/Quiver/Internal.lhs: -------------------------------------------------------------------------------- 1 | > -- | Module: Control.Quiver.Internal 2 | > -- Description: Common definitions 3 | > -- Copyright: © 2015 Patryk Zadarnowski 4 | > -- License: BSD3 5 | > -- Maintainer: pat@jantar.org 6 | > -- Stability: experimental 7 | > -- Portability: portable 8 | > -- 9 | > -- This module provides a host of common definitions, 10 | > -- including the main Quiver /processor/ type @P@, 11 | > -- that are reexported by other Quiver modules as 12 | > -- required. 13 | > -- 14 | > -- This is the only module in the Quiver library that 15 | > -- exposes the actual four constructors of the stream 16 | > -- processor type @P@, allowing for definition of low 17 | > -- level stream processor transformations, such as 18 | > -- conversions between @P@ and other stream processing 19 | > -- libraries. 20 | > -- 21 | > -- As a matter of style, Quiver users should strive to 22 | > -- avoid explicit pattern matching on the @P@ type and 23 | > -- rely instead on the various high level combinators 24 | > -- exported elsewhere, in order to improve chances of 25 | > -- successful deforestation by the various Quiver 26 | > -- rewrite rules. 27 | 28 | > {-# LANGUAGE RankNTypes, TupleSections #-} 29 | 30 | > module Control.Quiver.Internal ( 31 | > P (..), Producer, Consumer, Effect, 32 | > consume, produce, enclose, deliver, 33 | > decouple, deplete, 34 | > qlift, qhoist, qembed, 35 | > ) where 36 | 37 | > import Control.Monad.IO.Class 38 | > import Control.Monad.Morph 39 | 40 | 41 | Data Types 42 | ========== 43 | 44 | > -- | The main Quiver /stream processor/ type @P a a' b b' f r@, 45 | > -- representing a producer/consumer structure with /bidirectional/, 46 | > -- /bounded/ communication on both the upstream (consumer) and 47 | > -- downstream (producer) channel. The six type parameters have 48 | > -- the following intuitive meaning: 49 | > -- 50 | > -- * @a@ is the type of a /request/ values sent by the stream 51 | > -- processor to its upstream partner in order to receive the 52 | > -- next element of the input stream. 53 | > -- 54 | > -- * @a'@ is the type of the actual information being consumed 55 | > -- by this stream processor (i.e., elements of its input stream.) 56 | > -- 57 | > -- * @b@ is the type of the actual information being produced 58 | > -- by this stream processor (i.e., elements of its output stream.) 59 | > -- 60 | > -- * @b'@ is the type of the /response/ values received from 61 | > -- the downstream partner for each element of the output 62 | > -- stream produced by this stream processor. 63 | > -- 64 | > -- * @f@ is the type of the stream processor's /base functor/; 65 | > -- usually this is a monad used for stateful stream processing, 66 | > -- exception handling and/or real-world interaction. 67 | > -- 68 | > -- * @r@ is the stream processor's /delivery type/, used for 69 | > -- monadic stream processor definition. 70 | > -- 71 | > -- Every stream processor is a functor over its delivery type. 72 | > -- However, if the base functor @f@ meets the additional requirements 73 | > -- of 'Applicative' or 'Monad', so will the stream processor itself. 74 | > -- Note that, unlike most other stream processing libraries, @f@ 75 | > -- is not required to be a monad in most applications, although 76 | > -- only time will tell whether this generalisation has useful 77 | > -- applications in the real world. 78 | 79 | > data P a a' b b' f r = 80 | 81 | > -- | @Consume x k q@ represents a /consumer step/, in which 82 | > -- the request @x@ is sent upstream and the returned input 83 | > -- value is supplied to the /continuation processor/ @k@, 84 | > -- or, if the upstream partner has been /depleted/ (i.e., 85 | > -- delivered its ultimate result, hence reaching the end 86 | > -- of processing), to the /decoupled continuation/ @q@. 87 | 88 | > Consume a (a' -> P a a' b b' f r) (Producer b b' f r) | 89 | 90 | > -- | @Produce y k q@ represent a /producer step/, in which 91 | > -- the output value @y@ is sent downstream, and the returned 92 | > -- acknowledgement is supplied to the /continuation processor/ 93 | > -- @k@, or, if the downstream partner has been /decoupled/ 94 | > -- (i.e., delivered its ultimate result, hence reaching the end 95 | > -- of processing), to the /depleted continuation/ @q@. 96 | 97 | > Produce b (b' -> P a a' b b' f r) (Consumer a a' f r) | 98 | 99 | > -- | @Enclose@ allows for selective application of the base 100 | > -- functor @f@ the the remainder of the computation. 101 | 102 | > Enclose (f (P a a' b b' f r)) | 103 | 104 | > -- | @Deliver r@ completes processing of information, delivering 105 | > -- its ultimate result @r@. 106 | 107 | > Deliver r 108 | 109 | > -- | A Quiver /producer/, represented by a stream processor 110 | > -- with unspecified input types. 111 | 112 | > type Producer b b' f r = forall a a' . P a a' b b' f r 113 | 114 | > -- | A Quiver /consumer/, represented by a stream processor 115 | > -- with unspecified output types. 116 | 117 | > type Consumer a a' f r = forall b b' . P a a' b b' f r 118 | 119 | > -- | A Quiver /effect/, represented by a stream processor 120 | > -- with unspecified input and output types. 121 | 122 | > type Effect f r = forall a a' b b' . P a a' b b' f r 123 | 124 | 125 | Instances 126 | ========= 127 | 128 | > instance Functor f => Functor (P a a' b b' f) where 129 | > fmap ff (Consume x k q) = Consume x (fmap ff . k) (fmap ff q) 130 | > fmap ff (Produce y k q) = Produce y (fmap ff . k) (fmap ff q) 131 | > fmap ff (Enclose f) = Enclose (fmap (fmap ff) f) 132 | > fmap ff (Deliver r) = Deliver (ff r) 133 | > r <$ (Consume x k q) = Consume x ((r <$) . k) (r <$ q) 134 | > r <$ (Produce y k q) = Produce y ((r <$) . k) (r <$ q) 135 | > r <$ (Enclose f) = Enclose (fmap (r <$) f) 136 | > r <$ (Deliver _) = Deliver r 137 | 138 | > instance Applicative f => Applicative (P a a' b b' f) where 139 | > pure = Deliver 140 | > (Consume x k q) <*> p = Consume x ((<*> p) . k) (q <*> decouple p) 141 | > (Produce y k q) <*> p = Produce y ((<*> p) . k) (q <*> deplete p) 142 | > (Enclose f) <*> p = Enclose (fmap (<*> p) f) 143 | > (Deliver r) <*> p = fmap r p 144 | 145 | > instance Monad f => Monad (P a a' b b' f) where 146 | > (Consume x k q) >>= kk = Consume x ((>>= kk) . k) (q >>= decouple . kk) 147 | > (Produce y k q) >>= kk = Produce y ((>>= kk) . k) (q >>= deplete . kk) 148 | > (Enclose f) >>= kk = Enclose (fmap (>>= kk) f) 149 | > (Deliver r) >>= kk = kk r 150 | > fail = Enclose . fail 151 | 152 | > instance MonadTrans (P a a' b b') where 153 | > lift = qlift 154 | 155 | > instance MonadIO f => MonadIO (P a a' b b' f) where 156 | > liftIO = lift . liftIO 157 | 158 | > instance MFunctor (P a a' b b') where 159 | > hoist = qhoist 160 | 161 | > instance MMonad (P a a' b b') where 162 | > embed = qembed 163 | 164 | 165 | Primitive Combinators 166 | ===================== 167 | 168 | > -- | @consume x k q@ represents a /consumer step/, in which 169 | > -- the request @x@ is sent upstream and the returned input 170 | > -- value is supplied to the /continuation processor/ @k@, 171 | > -- or, if the upstream partner has been /depleted/ (i.e., 172 | > -- delivered its ultimate result, hence reaching the end 173 | > -- of processing), to the /decoupled continuation/ @q@. 174 | 175 | > consume :: a -> (a' -> P a a' b b' f r) -> Producer b b' f r -> P a a' b b' f r 176 | > consume = Consume 177 | 178 | > -- | @produce y k q@ represent a /producer step/, in which 179 | > -- the output value @y@ is sent downstream, and the returned 180 | > -- acknowledgement is supplied to the /continuation processor/ 181 | > -- @k@, or, if the downstream partner has been /decoupled/ 182 | > -- (i.e., delivered its ultimate result, hence reaching the end 183 | > -- of processing), to the /depleted continuation/ @q@. 184 | 185 | > produce :: b -> (b' -> P a a' b b' f r) -> Consumer a a' f r -> P a a' b b' f r 186 | > produce = Produce 187 | 188 | > -- | @enclose@ allows for selective application of the base 189 | > -- functor @f@ the the remainder of the computation. 190 | 191 | > enclose :: f (P a a' b b' f r) -> P a a' b b' f r 192 | > enclose = Enclose 193 | 194 | > -- | @deliver r@ completes processing of information, delivering 195 | > -- its ultimate result @r@. 196 | 197 | > deliver :: r -> P a a' b b' f r 198 | > deliver = Deliver 199 | 200 | 201 | Utilities 202 | ========= 203 | 204 | > -- | @decouple p@ /decouples/ the stream processor @p@, by replacing 205 | > -- the first consumer step in @p@ with that step's decoupled contination, 206 | > -- effectively converting @p@ into a producer processor that no longer 207 | > -- expects to receive any input. 208 | 209 | > decouple :: Functor f => P a a' b b' f r -> Producer b b' f r 210 | > decouple (Consume _ _ q) = q 211 | > decouple (Produce y k q) = Produce y (decouple . k) (decouple q) 212 | > decouple (Enclose f) = Enclose (fmap decouple f) 213 | > decouple (Deliver r) = Deliver r 214 | 215 | > -- | @deplete p@ /depletes/ the stream processor @p@, by replacing 216 | > -- the first producer step in @p@ with that step's depleted contination, 217 | > -- effectively converting @p@ into a consumer processor that will never 218 | > -- produce any more output. 219 | 220 | > deplete :: Functor f => P a a' b b' f r -> Consumer a a' f r 221 | > deplete (Consume x k q) = Consume x (deplete . k) (deplete q) 222 | > deplete (Produce _ _ q) = q 223 | > deplete (Enclose f) = Enclose (fmap deplete f) 224 | > deplete (Deliver r) = Deliver r 225 | 226 | 227 | Generalized Transformers 228 | ======================== 229 | 230 | > -- | Lifts the value of a base functor into a stream processor; 231 | > -- same as 'lift' from 'MonadTrans', but relaxing constraint 232 | > -- on the base structure from 'Monad' to 'Functor'. 233 | 234 | > qlift :: Functor f => f r -> P a a' b b' f r 235 | > qlift = enclose . fmap deliver 236 | 237 | > -- | Morphs the value of a base functor into another 238 | > -- functor by applying the supplied functor morphism to every 239 | > -- 'Enclose' step of a stream processor; same as 'hoist' from 240 | > -- 'MFunctor' but relaxing the constraint on the base structure 241 | > -- from 'Monad' to 'Functor'. 242 | 243 | > qhoist :: Functor f => (forall x . f x -> g x) -> P a a' b b' f r -> P a a' b b' g r 244 | > qhoist ff = loop 245 | > where 246 | > loop (Consume x k q) = consume x (loop . k) (qhoist ff q) 247 | > loop (Produce y k q) = produce y (loop . k) (qhoist ff q) 248 | > loop (Enclose f) = enclose (ff (fmap loop f)) 249 | > loop (Deliver r) = deliver r 250 | 251 | > -- | Embeds a monad within another monad transformer; 252 | > -- same as 'embed' from 'MMonad'. 253 | 254 | > qembed :: Monad g => (forall x . f x -> P a a' b b' g x) -> P a a' b b' f r -> P a a' b b' g r 255 | > qembed ff = loop 256 | > where 257 | > loop (Consume x k q) = consume x (loop . k) (decouple $ qembed ff q) 258 | > loop (Produce y k q) = produce y (loop . k) (deplete $ qembed ff q) 259 | > loop (Enclose f) = ff f >>= loop 260 | > loop (Deliver r) = deliver r 261 | -------------------------------------------------------------------------------- /src/Control/Quiver/SP.lhs: -------------------------------------------------------------------------------- 1 | > -- | Module: Control.Quiver.SP 2 | > -- Description: Simple stream processors 3 | > -- Copyright: © 2015 Patryk Zadarnowski 4 | > -- License: BSD3 5 | > -- Maintainer: pat@jantar.org 6 | > -- Stability: experimental 7 | > -- Portability: portable 8 | > -- 9 | > -- This module provides a definition of a /simple processor/ 10 | > -- with a unit request type and an unspecified acknowledgement 11 | > -- type, together with a number of common combinators for their 12 | > -- definitions. 13 | 14 | > {-# LANGUAGE PatternSynonyms, RankNTypes, ScopedTypeVariables, TupleSections #-} 15 | 16 | > module Control.Quiver.SP ( 17 | > module Control.Quiver, 18 | > SQ, SP, SProducer, SConsumer, SEffect, SPResult, 19 | > pattern SPComplete, 20 | > pattern SPFailed, 21 | > pattern SPIncomplete, 22 | > spcomplete, spfailed, spincomplete, 23 | > spconsume, 24 | > spfetch, spemit, (>:>), (>>?), (>>!), 25 | > sppure, spid, spconcat, spfilter, 26 | > spfold, spfold', spfoldl, spfoldl', spfoldr, 27 | > sptraverse, sptraverse_, 28 | > spevery, 29 | > spforever, 30 | > spuntil, spwhile, spWhileJust, 31 | > sprun, 32 | > ) where 33 | 34 | > import Control.Quiver 35 | > import Control.Quiver.Internal 36 | > import Data.Functor 37 | 38 | > infixr 5 >:> 39 | > infixl 1 >>?, >>! 40 | 41 | > -- | A /simple processor step/ with a unit request type and an unspecified 42 | > -- response type: 43 | 44 | > type SQ a b f r = forall b' . P () a b b' f r 45 | 46 | > -- | A /simple processor/ with a unit request type, an unspecified 47 | > -- response type and a result type tailored towards reporting the 48 | > -- terminating condition of an intermediate component in a composed 49 | > -- “processor stack”. 50 | 51 | > type SP a b f e = SQ a b f (SPResult e) 52 | 53 | > -- | A producer version of a simple processor. 54 | 55 | > type SProducer b f e = forall b' . Producer b b' f (SPResult e) 56 | 57 | > -- | A consumer version of a simple processor. 58 | 59 | > type SConsumer a f e = Consumer () a f (SPResult e) 60 | 61 | > -- | An effect version of a simple processor. 62 | 63 | > type SEffect f e = Effect f (SPResult e) 64 | 65 | > -- | Simple processor result type. 66 | 67 | > type SPResult e = Maybe (Maybe e) 68 | 69 | > -- | (@'Just' 'Nothing'@) Simple processor result value indicating successful processing of the entire input stream. 70 | 71 | > pattern SPComplete = Just Nothing 72 | 73 | > -- | (@'Just' ('Just' e)'@) Simple processor result value indicating unsuccessful processing of the input stream. 74 | 75 | > pattern SPFailed e = Just (Just e) 76 | 77 | > -- | ('Nothing') Simple processor result value indicating premature termination of the consumer. 78 | 79 | > pattern SPIncomplete = Nothing 80 | 81 | > -- | Delivers an 'SPComplete' result. 82 | 83 | > spcomplete :: P a a' b b' f (SPResult e) 84 | > spcomplete = deliver SPComplete 85 | 86 | > -- | Delivers an 'SPFailed' result. 87 | 88 | > spfailed :: e -> P a a' b b' f (SPResult e) 89 | > spfailed = deliver . SPFailed 90 | 91 | > -- | Delivers an 'SPIncomplete' result. 92 | 93 | > spincomplete :: P a a' b b' f (SPResult e) 94 | > spincomplete = deliver SPIncomplete 95 | 96 | > -- | Consumes an single input value of a simple stream processor. 97 | 98 | > spconsume :: (a' -> P () a' b b' f r) -> (Producer b b' f r) -> P () a' b b' f r 99 | > spconsume = consume () 100 | 101 | > -- | @spfetch@ represents a singleton simple stream processor that 102 | > -- delivers the next input value received, or @Nothing@ if the 103 | > -- upstream processor has been depleted. 104 | 105 | > spfetch :: Functor f => SQ a b f (Maybe a) 106 | > spfetch = fetch () 107 | 108 | > -- | @spemit y@ represents a singleton stream processor that 109 | > -- produces a single output value @y@, delivering either 110 | > -- 'SPComplete' if @y@ was consumed by the downstream processor, 111 | > -- or 'SPIncomplete' otherwise. 112 | 113 | > spemit :: b -> P a a' b b' f (SPResult e) 114 | > spemit y = produce y (const spcomplete) spincomplete 115 | 116 | > -- | @y >:> p@ represents a singleton stream processor that 117 | > -- produces a single output value @y@ and continues with 118 | > -- the processor 'p', deliverying 'SPIncomplete' if 'y' could 119 | > -- not be consumed by the downstream processor. 120 | 121 | > (>:>) :: b -> P a a' b b' f (SPResult e) -> P a a' b b' f (SPResult e) 122 | > y >:> p = produce y (const p) spincomplete 123 | 124 | > -- | @p >>? q@ continues processing of @p@ with @q@ but only 125 | > -- if @p@ completes successsfully by delivering 'SPComplete', 126 | > -- short-circuiting @q@ if @p@ fails with 'SPIncomplete' or 127 | > -- 'SPFailed'. 128 | 129 | > (>>?) :: Monad f => P a a' b b' f (SPResult e) -> P a a' b b' f (SPResult e) -> P a a' b b' f (SPResult e) 130 | > p >>? q = p >>= maybe spincomplete (maybe q spfailed) 131 | 132 | > -- | @p >>! k@ is equivalent to @p@, with any failures in @p@ 133 | > -- supplied to the continuation processor @k@. Note that 134 | > -- @k@ is not executed if @p@ completes successfully with 135 | > -- 'SPComplete' or is interrupted by the downstream processor, 136 | > -- delivering 'SPIncomplete'. 137 | 138 | > (>>!) :: Monad f => P a a' b b' f (SPResult e) -> (e -> P a a' b b' f (SPResult e')) -> P a a' b b' f (SPResult e') 139 | > p >>! k = p >>= maybe spincomplete (maybe spcomplete k) 140 | 141 | > -- | @sppure f@ produces an infinite consumer/producer that 142 | > -- uses a pure function @f@ to convert every input value into 143 | > -- an output; equivalent to @qpure id f (const ())@. 144 | 145 | > sppure :: (a -> b) -> SP a b f e 146 | > sppure f = cloop 147 | > where 148 | > cloop = consume () ploop spcomplete 149 | > ploop x = produce (f x) (const cloop) spincomplete 150 | 151 | > -- | A simple identity processor, equivalent to 'sppure id'. 152 | 153 | > spid :: SP a a f e 154 | > spid = cloop 155 | > where 156 | > cloop = consume () ploop spcomplete 157 | > ploop x = produce x (const cloop) spincomplete 158 | 159 | > -- | A simple list flattening processor requests. 160 | 161 | > spconcat :: Foldable t => SP (t a) a f e 162 | > spconcat = spconsume (foldr (>:>) spconcat) spcomplete 163 | 164 | > -- | A simple processor that filters its input stream. 165 | 166 | > spfilter :: (a -> Bool) -> SP a a f e 167 | > spfilter f = loop 168 | > where 169 | > loop = spconsume loop' spcomplete 170 | > loop' x = if f x then x >:> loop else loop 171 | 172 | > -- | A processor that delivers the entire input of the stream folded 173 | > -- into a single value using 'mappend'. 174 | 175 | > spfold :: Monoid a => SQ a x f a 176 | > spfold = cloop mempty 177 | > where 178 | > cloop r = spconsume (cloop . mappend r) (deliver r) 179 | 180 | > -- | A processor that delivers the entire input of the stream folded 181 | > -- into a single value using strict application of 'mappend'. 182 | 183 | > spfold' :: Monoid a => SQ a x f a 184 | > spfold' = cloop mempty 185 | > where 186 | > cloop r = r `seq` spconsume (cloop . mappend r) (deliver r) 187 | 188 | > -- | A processor that delivers the entire input of the stream folded 189 | > -- into a single value using the supplied left-associative function 190 | > -- and initial value. 191 | 192 | > spfoldl :: (b -> a -> b) -> b -> SQ a x f b 193 | > spfoldl f = cloop 194 | > where 195 | > cloop r = spconsume (cloop . f r) (deliver r) 196 | 197 | > -- | A processor that delivers the entire input of the stream folded 198 | > -- into a single value using strict application of the supplied 199 | > -- left-associative function and initial value. 200 | 201 | > spfoldl' :: (b -> a -> b) -> b -> SQ a x f b 202 | > spfoldl' f = cloop 203 | > where 204 | > cloop r = r `seq` spconsume (cloop . f r) (deliver r) 205 | 206 | > -- | A processor that delivers the entire input of the stream folded 207 | > -- into a single value using the supplied right-associative function 208 | > -- and initial value. 209 | > -- 210 | > -- Note that this can be quite inefficient for long streams, since 211 | > -- the entire chain of applications of 'f' needs to be materialised 212 | > -- on the heap before it can ever be applied to the final value and 213 | > -- reduced at the end of the stream. 214 | 215 | > spfoldr :: (a -> b -> b) -> b -> SQ a x f b 216 | > spfoldr f r = cloop id 217 | > where 218 | > cloop k = spconsume (\a -> cloop (k . f a)) (deliver (k r)) 219 | 220 | > -- | A processor that applies a monadic function to every input 221 | > -- element and emits the resulting value. 222 | 223 | > sptraverse :: Functor m => (a -> m b) -> SP a b m e 224 | > sptraverse k = loop 225 | > where 226 | > loop = spconsume loop' spcomplete 227 | > loop' x = enclose (fmap (>:> loop) (k x)) 228 | 229 | > -- | A processor that consumes every input elemnet using a monadic function. 230 | 231 | > sptraverse_ :: Functor m => (a -> m ()) -> SConsumer a m e 232 | > sptraverse_ k = loop 233 | > where 234 | > loop = spconsume loop' spcomplete 235 | > loop' x = enclose (k x $> loop) 236 | 237 | > -- | Produces every element of a foldable structure. 238 | 239 | > spevery :: Foldable t => t a -> SProducer a f e 240 | > spevery = foldr (>:>) spcomplete 241 | 242 | > -- | Produces infinite sequence of monadic results. 243 | 244 | > spforever :: Functor f => f a -> SProducer a f e 245 | > spforever f = loop 246 | > where 247 | > loop = enclose (fmap (>:> loop) f) 248 | 249 | > -- | Interrupts processing on input that matches a specified predicate. 250 | 251 | > spuntil :: (a -> Bool) -> SP a a f e 252 | > spuntil f = loop 253 | > where 254 | > loop = spconsume loop' spcomplete 255 | > loop' x = if f x then spcomplete else x >:> loop 256 | 257 | > -- | Interrupts processing on input that doesn't match a specified predicate. 258 | 259 | > spwhile :: (a -> Bool) -> SP a a f e 260 | > spwhile f = spuntil (not . f) 261 | 262 | > -- | Interrupts processing on a first occurence of 'Nothing' in the input stream. 263 | 264 | > spWhileJust :: SP (Maybe a) a f e 265 | > spWhileJust = spconsume (maybe spcomplete (>:> spWhileJust)) spcomplete 266 | 267 | > -- | Evaluates an 'SEffect', i.e., a simple processor that is both detached 268 | > -- and depleted and hence neither consumes nor produces any input, 269 | > -- returning its delivered value. The base functor must be a monad. 270 | 271 | > sprun :: Monad f => forall a b . SQ a b f r -> f r 272 | > sprun p = loop p 273 | > where 274 | > loop (Consume _ _ q) = loop q 275 | > loop (Produce _ _ q) = loop q 276 | > loop (Enclose f) = f >>= loop 277 | > loop (Deliver r) = return r 278 | 279 | -------------------------------------------------------------------------------- /src/Control/Quiver/Trans.lhs: -------------------------------------------------------------------------------- 1 | > -- | Module: Control.Quiver.Trans 2 | > -- Description: Monad transformers for quiver processors 3 | > -- Copyright: © 2015 Patryk Zadarnowski 4 | > -- License: BSD3 5 | > -- Maintainer: pat@jantar.org 6 | > -- Stability: experimental 7 | > -- Portability: portable 8 | > -- 9 | > -- This module provides functions for hoisting stream processors 10 | > -- over the various well-known monad transformers into the corresponding 11 | > -- base monad, in a manner analogous to the tranformers' @run@ function. 12 | > -- 13 | > -- This is particularly useful for composing quiver processors over 14 | > -- distinct “compatible” monads such as 'ReaderT' and 'StateT'. 15 | 16 | > {-# LANGUAGE RankNTypes #-} 17 | > {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 18 | 19 | > module Control.Quiver.Trans ( 20 | > qRunErrorT, 21 | > qRunExceptT, 22 | > qRunMaybeT, 23 | > qRunRWST, qRunLazyRWST, qRunStrictRWST, 24 | > qRunReaderT, 25 | > qRunStateT, qRunLazyStateT, qRunStrictStateT, 26 | > qRunWriterT, qRunLazyWriterT, qRunStrictWriterT, 27 | > ) where 28 | 29 | > import Control.Monad.Trans.Error 30 | > import Control.Monad.Trans.Except 31 | > import Control.Monad.Trans.Maybe 32 | > import Control.Monad.Trans.RWS.Lazy as Lazy 33 | > import Control.Monad.Trans.RWS.Strict as Strict 34 | > import Control.Monad.Trans.Reader 35 | > import Control.Monad.Trans.State.Lazy as Lazy 36 | > import Control.Monad.Trans.State.Strict as Strict 37 | > import Control.Monad.Trans.Writer.Lazy as Lazy 38 | > import Control.Monad.Trans.Writer.Strict as Strict 39 | > import Control.Quiver.Internal 40 | 41 | > -- | Hoists a stream processor from an 'ErrorT e m' monad into its base monad @m@. 42 | 43 | > qRunErrorT :: Functor m => P a a' b b' (ErrorT e m) r -> P a a' b b' m (Either e r) 44 | > qRunErrorT = loop 45 | > where 46 | > loop (Consume x k q) = consume x (loop . k) (qRunErrorT q) 47 | > loop (Produce y k q) = produce y (loop . k) (qRunErrorT q) 48 | > loop (Enclose f) = enclose (either (deliver . Left) loop <$> runErrorT f) 49 | > loop (Deliver r) = deliver (Right r) 50 | 51 | > -- | Hoists a stream processor from an 'ExceptT e m' monad into its base monad @m@. 52 | 53 | > qRunExceptT :: Functor m => P a a' b b' (ExceptT e m) r -> P a a' b b' m (Either e r) 54 | > qRunExceptT = loop 55 | > where 56 | > loop (Consume x k q) = consume x (loop . k) (qRunExceptT q) 57 | > loop (Produce y k q) = produce y (loop . k) (qRunExceptT q) 58 | > loop (Enclose f) = enclose (either (deliver . Left) loop <$> runExceptT f) 59 | > loop (Deliver r) = deliver (Right r) 60 | 61 | > -- | Hoists a stream processor from a 'MaybeT m' monad into its base monad @m@. 62 | 63 | > qRunMaybeT :: Functor m => P a a' b b' (MaybeT m) r -> P a a' b b' m (Maybe r) 64 | > qRunMaybeT = loop 65 | > where 66 | > loop (Consume x k q) = consume x (loop . k) (qRunMaybeT q) 67 | > loop (Produce y k q) = produce y (loop . k) (qRunMaybeT q) 68 | > loop (Enclose f) = enclose (maybe (deliver Nothing) loop <$> runMaybeT f) 69 | > loop (Deliver r) = deliver (Just r) 70 | 71 | > -- | Hoists a stream processor from a lazy 'RWST r w s m' monad into its base monad @m@. 72 | 73 | > qRunRWST :: (Functor m, Monoid mw) => P a a' b b' (Lazy.RWST mr mw ms m) r -> mr -> ms -> P a a' b b' m (r, ms, mw) 74 | > qRunRWST = qRunLazyRWST 75 | 76 | > -- | Hoists a stream processor from a lazy 'RWST r w s m' monad into its base monad @m@. 77 | 78 | > qRunLazyRWST :: (Functor m, Monoid mw) => P a a' b b' (Lazy.RWST mr mw ms m) r -> mr -> ms -> P a a' b b' m (r, ms, mw) 79 | > qRunLazyRWST p mr ms = loop p 80 | > where 81 | > loop (Consume x k q) = consume x (loop . k) (qRunLazyRWST q mr ms) 82 | > loop (Produce y k q) = produce y (loop . k) (qRunLazyRWST q mr ms) 83 | > loop (Enclose f) = enclose (run <$> Lazy.runRWST f mr ms) 84 | > loop (Deliver r) = deliver (r, ms, mempty) 85 | > run ~(p', ms', mw) = adj mw <$> qRunLazyRWST p' mr ms' 86 | > adj mw ~(r, ms', mw') = (r, ms', mappend mw mw') 87 | 88 | > -- | Hoists a stream processor from a strict 'RWST r w s m' monad into its base monad @m@. 89 | 90 | > qRunStrictRWST :: (Functor m, Monoid mw) => P a a' b b' (Strict.RWST mr mw ms m) r -> mr -> ms -> P a a' b b' m (r, ms, mw) 91 | > qRunStrictRWST p mr ms = loop p 92 | > where 93 | > loop (Consume x k q) = consume x (loop . k) (qRunStrictRWST q mr ms) 94 | > loop (Produce y k q) = produce y (loop . k) (qRunStrictRWST q mr ms) 95 | > loop (Enclose f) = enclose (run <$> Strict.runRWST f mr ms) 96 | > loop (Deliver r) = deliver (r, ms, mempty) 97 | > run (p', ms', mw) = adj mw <$> qRunStrictRWST p' mr ms' 98 | > adj mw (r, ms', mw') = (r, ms', mappend mw mw') 99 | 100 | > -- | Hoists a stream processor from a 'ReaderT r m' monad into its base monad @m@. 101 | 102 | > qRunReaderT :: Functor m => P a a' b b' (ReaderT mr m) r -> mr -> P a a' b b' m r 103 | > qRunReaderT p mr = loop p 104 | > where 105 | > loop (Consume x k q) = consume x (loop . k) (qRunReaderT q mr) 106 | > loop (Produce y k q) = produce y (loop . k) (qRunReaderT q mr) 107 | > loop (Enclose f) = enclose (loop <$> runReaderT f mr) 108 | > loop (Deliver r) = deliver r 109 | 110 | > -- | Hoists a stream processor from a lazy 'StateT s m' monad into its base monad @m@. 111 | 112 | > qRunStateT :: Functor m => P a a' b b' (Lazy.StateT ms m) r -> ms -> P a a' b b' m (r, ms) 113 | > qRunStateT = qRunLazyStateT 114 | 115 | > -- | Hoists a stream processor from a lazy 'StateT s m' monad into its base monad @m@. 116 | 117 | > qRunLazyStateT :: Functor m => P a a' b b' (Lazy.StateT ms m) r -> ms -> P a a' b b' m (r, ms) 118 | > qRunLazyStateT p ms = loop p 119 | > where 120 | > loop (Consume x k q) = consume x (loop . k) (qRunLazyStateT q ms) 121 | > loop (Produce y k q) = produce y (loop . k) (qRunLazyStateT q ms) 122 | > loop (Enclose f) = enclose (run <$> Lazy.runStateT f ms) 123 | > loop (Deliver r) = deliver (r, ms) 124 | > run ~(p', ms') = qRunLazyStateT p' ms' 125 | 126 | > -- | Hoists a stream processor from a strict 'StateT s m' monad into its base monad @m@. 127 | 128 | > qRunStrictStateT :: Functor m => P a a' b b' (Strict.StateT ms m) r -> ms -> P a a' b b' m (r, ms) 129 | > qRunStrictStateT p ms = loop p 130 | > where 131 | > loop (Consume x k q) = consume x (loop . k) (qRunStrictStateT q ms) 132 | > loop (Produce y k q) = produce y (loop . k) (qRunStrictStateT q ms) 133 | > loop (Enclose f) = enclose (uncurry qRunStrictStateT <$> Strict.runStateT f ms) 134 | > loop (Deliver r) = deliver (r, ms) 135 | 136 | > -- | Hoists a stream processor from a lazy 'WriterT w m' monad into its base monad @m@. 137 | 138 | > qRunWriterT :: (Functor m, Monoid mw) => P a a' b b' (Lazy.WriterT mw m) r -> P a a' b b' m (r, mw) 139 | > qRunWriterT = qRunLazyWriterT 140 | 141 | > -- | Hoists a stream processor from a lazy 'WriterT w m' monad into its base monad @m@. 142 | 143 | > qRunLazyWriterT :: (Functor m, Monoid mw) => P a a' b b' (Lazy.WriterT mw m) r -> P a a' b b' m (r, mw) 144 | > qRunLazyWriterT p = loop p 145 | > where 146 | > loop (Consume x k q) = consume x (loop . k) (qRunLazyWriterT q) 147 | > loop (Produce y k q) = produce y (loop . k) (qRunLazyWriterT q) 148 | > loop (Enclose f) = enclose (run <$> Lazy.runWriterT f) 149 | > loop (Deliver r) = deliver (r, mempty) 150 | > run ~(p', mw) = adj mw <$> qRunLazyWriterT p' 151 | > adj mw ~(r, mw') = (r, mappend mw mw') 152 | 153 | > -- | Hoists a stream processor from a strict 'WriterT w m' monad into its base monad @m@. 154 | 155 | > qRunStrictWriterT :: (Functor m, Monoid mw) => P a a' b b' (Strict.WriterT mw m) r -> P a a' b b' m (r, mw) 156 | > qRunStrictWriterT p = loop p 157 | > where 158 | > loop (Consume x k q) = consume x (loop . k) (qRunStrictWriterT q) 159 | > loop (Produce y k q) = produce y (loop . k) (qRunStrictWriterT q) 160 | > loop (Enclose f) = enclose (run <$> Strict.runWriterT f) 161 | > loop (Deliver r) = deliver (r, mempty) 162 | > run (p', mw) = adj mw <$> qRunStrictWriterT p' 163 | > adj mw (r, mw') = (r, mappend mw mw') 164 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | resolver: lts-3.7 6 | --------------------------------------------------------------------------------