├── .gitignore ├── Setup.hs ├── test └── Spec.hs ├── app └── Main.hs ├── src └── Data │ ├── Transducer │ └── Conduit.hs │ └── Transducer.hs ├── LICENSE ├── transducer.cabal ├── stack.yaml └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /.stack-work 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Conduit 4 | import qualified Data.Conduit.List as CL 5 | import qualified Data.Transducer as T 6 | import Data.Transducer.Conduit 7 | 8 | -- This is the current pain of this version of Haskell transducers: You have to 9 | -- manually write the state types. It's not a problem, because you would always 10 | -- depend on a rigid input state type, but it's hairy when you want to add type 11 | -- signatures. 12 | myXform :: T.Transducer s (Int, (Maybe ([Int], Int), s)) [Int] Int 13 | myXform = T.take 10 . T.map f . T.partitionBy (`mod` 3) 14 | where f x = 3 * x^3 - 2 * x^2 + 2 * x 15 | 16 | main :: IO () 17 | main = do 18 | mapM_ print $ T.sequence myXform [1..] 19 | CL.sourceList [1..] $$ toConduit myXform =$ CL.mapM_ print 20 | -------------------------------------------------------------------------------- /src/Data/Transducer/Conduit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, RankNTypes #-} 2 | 3 | module Data.Transducer.Conduit 4 | ( toConduit 5 | ) where 6 | 7 | import Data.Transducer 8 | import Data.Conduit 9 | 10 | -- Yields the bs it receives 11 | conduitYielder :: Monad m => Reducer () b (Conduit a m b) 12 | conduitYielder = stateless run 13 | where run m x = m >> yield x 14 | 15 | conduitAwaiter :: Monad m => (Reducer s a (Conduit a m b)) -> Conduit a m b 16 | conduitAwaiter (Reducer is c f) = go is 17 | where go s = do mval <- await 18 | case mval of 19 | (Just val) -> feed s val 20 | Nothing -> feedLast s 21 | feed s val = case f s (return ()) val of 22 | (s', Reduced comp) -> comp >> feedLast s' 23 | (s', Continue comp) -> comp >> go s' 24 | feedLast s = c s (return ()) 25 | 26 | -- | toConduit takes a Transducer and converts it into a Conduit for any monad m 27 | toConduit :: Monad m => Transducer () s a b -> Conduit b m a 28 | toConduit xform = conduitAwaiter (xform conduitYielder) 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Jean Niklas L'orange (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /transducer.cabal: -------------------------------------------------------------------------------- 1 | name: transducer 2 | version: 0.1.0.0 3 | synopsis: Clojure's Transducer in Haskell 4 | description: Please see README.md 5 | homepage: https://github.com/hyPiRion/haskell-transducers#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Jean Niklas L'orange 9 | maintainer: jeannikl@hypirion.com 10 | copyright: 2016 Jean Niklas L'orange 11 | category: Data 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Data.Transducer 19 | , Data.Transducer.Conduit 20 | build-depends: base >= 4.7 && < 5 21 | , comonad 22 | , conduit 23 | default-language: Haskell2010 24 | 25 | executable haskell-transducers-exe 26 | hs-source-dirs: app 27 | main-is: Main.hs 28 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 29 | build-depends: base 30 | , transducer 31 | , conduit 32 | default-language: Haskell2010 33 | 34 | test-suite haskell-transducers-test 35 | type: exitcode-stdio-1.0 36 | hs-source-dirs: test 37 | main-is: Spec.hs 38 | build-depends: base 39 | , transducer 40 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 41 | default-language: Haskell2010 42 | 43 | source-repository head 44 | type: git 45 | location: https://github.com/hyPiRion/haskell-transducers 46 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-5.17 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.1" 56 | # compiler-check: newer-minor 57 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell Transducers 2 | 3 | Transducers for Haskell. See explanation in my blogpost 4 | [Clojure's Transducers in Haskell](http://hypirion.com/musings/haskell-transducers). 5 | 6 | Transducers are used for stream manipulation, where the stream type is unknown a 7 | priori: It can be list mapping, reductions, used for Conduits, or for your own 8 | types or needs. The input and output stream types are decoupled from eachother. 9 | 10 | ## Quickstart 11 | 12 | The transducers library expose three types: `Reduced`, `Reducer` and 13 | `Transducer`. 14 | 15 | The `Reducer` type is a generalisation over the function one would usually pass 16 | to `foldl`, and has the following definition: 17 | 18 | ```haskell 19 | data Reducer s a b = Reducer { initState :: s, 20 | complete :: s -> b -> b, 21 | step :: s -> b -> a -> (s, Reduced b) 22 | } 23 | ``` 24 | 25 | The `s` in a Reducer is its internal state. `initState` specifies the initial 26 | state of the Reducer, when it has not yet been used. 27 | 28 | At the end of the "stream", complete is called with the state and the current 29 | accumulated value, and must return a new accumulated value. Usually you would 30 | pass back the accumulated value (`const id`), but complete can be used for 31 | cleanup or final changes to the value. 32 | 33 | The `step` function is called for every element of type `a` in the "stream" or 34 | "process" the Reducer is ran over. It returns the new state, and a Reduced 35 | accumulated result. 36 | 37 | The Reduced type describes a return value from step, and its definition is as 38 | follows: 39 | 40 | ```haskell 41 | data Reduced a = Continue a 42 | | Reduced a 43 | deriving (Eq, Ord, Show, Read, Functor) 44 | ``` 45 | 46 | A value of Continue signals that we would like to receive more input, if there 47 | are any. Reduced signals that we will not use further input for anything, and 48 | that the function calling can short-circuit if it would like to. 49 | 50 | Reduced is also a comonad, in case you would like to perform extract, duplicate 51 | or extend on it. 52 | 53 | A transducer is a function from Reducer to Reducer, and does not care about the 54 | reducing value: 55 | 56 | ```haskell 57 | {-# LANGUAGE RankNTypes #-} 58 | 59 | type Transducer s t a b = forall r. Reducer s a r -> Reducer t b r 60 | ``` 61 | 62 | You should not let transducers specify constraints on `s`, a proper transducer 63 | will work for any `s`. 64 | 65 | The transducers library provides a lot of predefined transducers, for example 66 | `map`, `filter`, `take`, `drop`, `partitionBy`, `dedupe`. 67 | 68 | To run a reducing function, you would like to use `reduce`: It works like 69 | `foldl'` but for `Reducer`s. You can use `stateless` to make a Reducer that 70 | works like functions passed to foldl': 71 | 72 | ```haskell 73 | import qualified Data.Transducer as T 74 | 75 | T.reduce (T.stateless (+)) == foldl' (+) 76 | 77 | T.reduce (T.take 10 $ T.stateless (+)) 0 [1..] == foldl' (+) 0 (take 10 [1..]) 78 | ``` 79 | 80 | To run a transducer over a list, use `sequence`: 81 | 82 | ```haskell 83 | import qualified Data.Transducer as T 84 | 85 | *> T.sequence (T.map (+10)) [1..10] 86 | [11,12,13,14,15,16,17,18,19,20] 87 | *> T.sequence T.double [1..10] 88 | [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10] 89 | *> T.sequence T.dedupe [1, 1, 2, 3, 3, 4, 3] 90 | [1,2,3,4,3] 91 | ``` 92 | 93 | You can compose transducers via function composition to create a new transducer. 94 | Note that transducer composition is contravariant, so read evaluation order from 95 | left to right, not right to left: 96 | 97 | ```haskell 98 | import qualified Data.Transducer as T 99 | 100 | *> map (* 4) . map (+ 10) $ [10] 101 | [80] 102 | -- map f . map g $ lst == map (f . g) lst 103 | 104 | *> T.sequence (T.map (* 4) . T.map (+ 10)) [10] 105 | [50] 106 | -- T.map f . T.map g == T.map (g . f) 107 | 108 | *> T.sequence (T.double . T.take 10) [1..] 109 | [1,1,2,2,3,3,4,4,5,5] 110 | ``` 111 | 112 | Transducers can be converted into conduits by using the `toConduit` function 113 | provided in `Data.Transducer.Conduit`: 114 | 115 | ```haskell 116 | import Data.Conduit 117 | import qualified Data.Conduit.List as CL 118 | import qualified Data.Transducer as T 119 | import Data.Transducer.Conduit 120 | 121 | *> CL.sourceList [1..] $$ toConduit (T.take 2 . T.double) =$ CL.mapM_ print 122 | 1 123 | 1 124 | 2 125 | 2 126 | ``` 127 | 128 | They can also in theory be created from a conduit. Help implementing the 129 | `fromConduit` function is appreciated. 130 | 131 | You can also create your own transducers and your own functions that manipulate 132 | them. See 133 | [Clojure's Transducers in Haskell](http://hypirion.com/musings/haskell-transducers) 134 | for more information. 135 | 136 | ## Real World Production Usage 137 | 138 | Use [conduits](https://github.com/snoyberg/conduit) instead. This library will 139 | (most likely) not be published nor maintained. 140 | 141 | ## License 142 | 143 | Copyright © 2016 Jean Niklas L'orange 144 | 145 | Distributed under the BSD 3-clause license, which is available in the file 146 | LICENSE. 147 | -------------------------------------------------------------------------------- /src/Data/Transducer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, RankNTypes #-} 2 | 3 | module Data.Transducer 4 | ( Reduced(..), 5 | Reducer(..), 6 | Transducer, 7 | dedupe, 8 | double, 9 | drop, 10 | dropNth, 11 | filter, 12 | map, 13 | partitionBy, 14 | preservingReduce, 15 | reduce, 16 | sequence, 17 | stateless, 18 | take, 19 | ) where 20 | 21 | import Prelude hiding (init, sequence, take, drop, map, pred, filter) 22 | import Control.Comonad 23 | 24 | data Reduced a = Continue a 25 | | Reduced a 26 | deriving (Eq, Ord, Show, Read, Functor) 27 | 28 | instance Comonad Reduced where 29 | extract (Continue x) = x 30 | extract (Reduced x) = x 31 | 32 | duplicate (Continue x) = Continue $ Continue x 33 | duplicate (Reduced x) = Reduced $ Reduced x 34 | 35 | data Reducer s a b = Reducer { initState :: s, 36 | complete :: s -> b -> b, 37 | step :: s -> b -> a -> (s, Reduced b) 38 | } 39 | 40 | stateless :: (b -> a -> b) -> Reducer () a b 41 | stateless f = Reducer { initState = (), 42 | complete = const id, 43 | step = \_ x y -> ((), Continue $ f x y) 44 | } 45 | 46 | 47 | reduce' :: (s -> b -> a -> (s, Reduced b)) -> s -> b -> [a] -> (s, b) 48 | reduce' _ state acc [] = (state, acc) 49 | reduce' f state acc (x:xs) = case f state acc x of 50 | (s, Reduced v) -> (s, v) 51 | (s, Continue v) -> reduce' f s v xs 52 | 53 | reduce :: Reducer s a b -> b -> [a] -> b 54 | reduce (Reducer is c f) z as 55 | = let (state, res) = reduce' f is z as 56 | in c state res 57 | 58 | -- TODO: Could we make a Transducer into a Monad to avoid the state? We probably 59 | -- just reimplement Conduits/Pipes by doing so, so doesn't seem too fruitful. 60 | -- TODO: Possible to ensure s is rigid? We need to be able to refer to t though, 61 | -- so we cannot omit it? 62 | type Transducer s t a b = forall r. Reducer s a r -> Reducer t b r 63 | 64 | -- This is terrible, and is only used as an example. Please use Data.Sequence 65 | -- instead if you need fast right appends 66 | conj :: [a] -> a -> [a] 67 | conj xs x = xs ++ [x] 68 | 69 | listReducer :: Reducer () a [a] 70 | listReducer = stateless conj 71 | 72 | sequence :: Transducer () t b a -> [a] -> [b] 73 | sequence xform = go is 74 | where go s [] = c s [] 75 | go s (x:xs) = case f s [] x of 76 | (s', Reduced res) -> res ++ go s' [] 77 | (s', Continue res) -> res ++ go s' xs 78 | (Reducer is c f) = xform listReducer 79 | 80 | -- NB: This is not a transducer! 81 | preserveReduced :: Reducer s a b -> Reducer s a (Reduced b) 82 | preserveReduced (Reducer is c f) = Reducer { initState = is, 83 | complete = fmap . c, 84 | step = preserveStep 85 | } 86 | where preserveStep state acc x = 87 | let (state', v) = f state (extract acc) x 88 | in (state', duplicate v) 89 | 90 | -- Like reduce, but preserves Reduced. Useful if you need to know whether you 91 | -- short-circuited or not. 92 | preservingReduce :: Reducer s a b -> b -> [a] -> Reduced b 93 | preservingReduce f x ys = reduce (preserveReduced f) (Continue x) ys 94 | 95 | take :: Int -> Transducer s (Int, s) a a 96 | take n (Reducer is c f) = Reducer { initState = (n, is), 97 | complete = c . snd, 98 | step = takeStep 99 | } 100 | where takeStep (curN, s) res x 101 | | 0 < curN = let (s', v) = f s res x in 102 | ((curN - 1, s'), v) 103 | | otherwise = ((curN, s), Reduced res) 104 | 105 | drop :: Int -> Transducer s (Int, s) a a 106 | drop n (Reducer is c f) = Reducer { initState = (n, is), 107 | complete = c . snd, 108 | step = dropStep 109 | } 110 | where dropStep (n, s) res x 111 | | 0 < n = ((n - 1, s), Continue res) 112 | | otherwise = let (s', v) = f s res x in 113 | ((0, s'), v) 114 | 115 | map :: (a -> b) -> Transducer s s b a 116 | map f (Reducer is c stepFn) = Reducer { initState = is, 117 | complete = c, 118 | step = mapStep 119 | } 120 | where mapStep s res x = stepFn s res (f x) 121 | 122 | filter :: (a -> Bool) -> Transducer s s a a 123 | filter pred (Reducer is c stepFn) = Reducer { initState = is, 124 | complete = c, 125 | step = filterStep 126 | } 127 | where filterStep s acc x 128 | | pred x = stepFn s acc x 129 | | otherwise = (s, Continue acc) 130 | 131 | partitionBy :: Eq x => (a -> x) -> Transducer s (Maybe ([a], x), s) [a] a 132 | partitionBy pfn (Reducer is c stepFn) 133 | = Reducer { initState = (Nothing, is), 134 | complete = partitionComplete, 135 | step = partitionStep 136 | } 137 | where partitionComplete (Nothing, s) x = c s x 138 | partitionComplete (Just (xs, _), s) acc 139 | = let (state', res) = stepFn s acc xs 140 | in c state' (extract res) 141 | partitionStep (Nothing, s) acc x 142 | = ((Just ([x], pfn x), s), Continue acc) 143 | partitionStep (Just (as, cmp), s) acc x 144 | | cmp == pfn x = ((Just (conj as x, cmp), s), 145 | Continue acc) 146 | | otherwise = let (state', acc') = stepFn s acc as 147 | in ((Just ([x], pfn x), state'), acc') 148 | 149 | dropNth :: Int -> Transducer s (Int, s) a a 150 | dropNth nInit (Reducer is c stepFn) = Reducer { initState = (nInit - 1, is), 151 | complete = c . snd, 152 | step = dropNthStep 153 | } 154 | where dropNthStep (n, s) acc x 155 | | 0 < n = let (s', res) = stepFn s acc x 156 | in ((n - 1, s'), res) 157 | | otherwise = ((nInit - 1, s), Continue acc) 158 | 159 | double :: Transducer s s a a 160 | double (Reducer is c f) = Reducer { initState = is, 161 | complete = c, 162 | step = doubleStep 163 | } 164 | where doubleStep s acc x 165 | = case f s acc x of 166 | (s', Continue v) -> f s' v x 167 | reduced -> reduced 168 | 169 | dedupe :: Eq a => Transducer s (Maybe a, s) a a 170 | dedupe (Reducer is c f) = Reducer { initState = (Nothing, is), 171 | complete = c . snd, 172 | step = dedupeStep 173 | } 174 | where dedupeStep (Nothing, s) acc x 175 | = let (s', acc') = f s acc x in 176 | ((Just x, s'), acc') 177 | dedupeStep (Just x, s) acc v 178 | | x == v = ((Just x, s), Continue acc) 179 | | otherwise = dedupeStep (Nothing, s) acc v 180 | --------------------------------------------------------------------------------