├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── build.sh ├── default.nix ├── rebuild.sh ├── src ├── Test │ └── Transducers │ │ ├── Core.idr │ │ ├── Examples.idr │ │ └── Utils.idr ├── Transducers.idr └── Transducers │ ├── Algorithms.idr │ ├── Core.idr │ └── Utils.idr ├── test.sh └── transducers.ipkg /.gitignore: -------------------------------------------------------------------------------- 1 | *.ibc 2 | .DS_Store 3 | ReducersTest 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | script: nix-shell -A IdrisReducers --command "bash rebuild.sh && bash test.sh" 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Quentin Duval (c) 2017 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 Quentin Duval 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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Idris Transducers 2 | 3 | [![Build Status](https://travis-ci.org/QuentinDuval/IdrisReducers.svg?branch=master)](https://travis-ci.org/QuentinDuval/IdrisReducers) 4 | 5 | Implementation a transducer-like library in Idris, inspired by the great Clojure transducer library: https://clojure.org/reference/transducers. 6 | 7 | ## Goal & Motivation 8 | 9 | The goal is to provide transformation of accumulating functions that: 10 | 11 | * Can be composed together as pipe-lines of transformations 12 | * Do not suffer from the overhead of creating intermediary lists 13 | * Can support arbitrary inner state (for non trivial transformations) 14 | 15 | ## Documentation 16 | 17 | The main concepts and their associated types are introduced in this blog post. This should help you understand what transducers are and how to build you own: 18 | https://deque.blog/2017/07/28/implementing-clojure-like-transducers-in-idris-part-1/ 19 | 20 | Further articles are coming to explain how to build more complex transducers. 21 | 22 | ## Examples 23 | 24 | Here is a first example of transformations we can write: 25 | 26 | * Take a collection as input 27 | * Keep only the odd numbers 28 | * Repeat these numbers twice (twice is `replicate 2`) 29 | * Sum the resulting stream of integer values 30 | 31 | This would look like this: 32 | 33 | -- Standard Idris (creating intermediary lists) 34 | foldl (+) 0 (map (+1) (concatMap twice (filter odd [1..100]))) 35 | 36 | -- Using the transducers 37 | transduce (filtering odd . catMapping twice . mapping (+1)) (+) 0 [1..100] 38 | 39 | These transformations do not realize intermediary lists, and do not necessarily consume the entire stream of values. The stream is consumed lazily. The code below will execute much faster with transducers: 40 | 41 | -- Standard Idris (not lazy: mapping 1000 values) 42 | foldl (+) 0 (take 10 (map (+1) [1..1000])) 43 | 44 | -- With the transducers (lazy: mapping 10 values) 45 | transduce (mapping (+1) . taking 10) (+) 0 [1..1000] 46 | 47 | We can also add stateful transformations in the pipe, such as one that remove adjacent duplicated elements: 48 | 49 | transduce (mapping singleton . deduplicate) (++) "" (unpack "abbcddccbaad") 50 | > "abcdcbad" 51 | 52 | * `mapping singleton` transforms every character into a string 53 | * `deduplicate` removes adjacent duplicated elements 54 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | idris --build transducers.ipkg 4 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | # This is used in the Travis build to install the Idris compiler. 2 | let 3 | pkgs = import {}; 4 | stdenv = pkgs.stdenv; 5 | in { 6 | IdrisReducers = stdenv.mkDerivation { 7 | name = "IdrisReducers"; 8 | src = ./.; 9 | buildInputs = with pkgs; [ haskellPackages.idris gmp ]; 10 | }; 11 | } 12 | -------------------------------------------------------------------------------- /rebuild.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | idris --clean transducers.ipkg 4 | ./build.sh 5 | -------------------------------------------------------------------------------- /src/Test/Transducers/Core.idr: -------------------------------------------------------------------------------- 1 | module Test.Transducers.Core 2 | 3 | import Transducers 4 | import Test.Transducers.Utils 5 | 6 | 7 | -------------------------------------------------------------------------------- 8 | -- Unit tests 9 | -------------------------------------------------------------------------------- 10 | 11 | should_map : List Int -> Test 12 | should_map input = 13 | assertEq 14 | (foldl (+) 0 (map (*2) input)) 15 | (transduce (mapping (*2)) (+) 0 input) 16 | 17 | should_follow_map_law : Test 18 | should_follow_map_law = 19 | assertEq 20 | (transduce (mapping length . mapping (*2)) (+) 0 ["abc", "", "cdef", "g"]) 21 | (transduce (mapping ((*2) . length)) (+) 0 ["abc", "", "cdef", "g"]) 22 | 23 | should_filter : List Int -> Test 24 | should_filter input = 25 | assertEq 26 | (foldl (+) 0 (filter odd input)) 27 | (transduce (filtering odd) (+) 0 input) 28 | 29 | should_concat_map : List Int -> Test 30 | should_concat_map input = 31 | assertEq 32 | (foldl (+) 0 (concatMap twice input)) 33 | (transduce (catMapping twice) (+) 0 input) 34 | 35 | should_reduce_terminal : List Int -> Test 36 | should_reduce_terminal input = 37 | assertEq 38 | (foldl (+) 0 (filter odd (map (*2) input))) 39 | (reduce (mapping (*2) . filtering odd $ terminal (+)) 0 input) 40 | 41 | should_take : List Int -> Test 42 | should_take input = 43 | assertEq 44 | (foldl (+) 0 (take 10 input)) 45 | (transduce (taking 10) (+) 0 input) 46 | 47 | should_take_while : Test 48 | should_take_while = 49 | assertEq 55 $ transduce (takingWhile (<= 10)) (+) 0 [1..100] 50 | 51 | should_drop : List Int -> Test 52 | should_drop input = 53 | assertEq 54 | (foldl (+) 0 (drop 10 input)) 55 | (transduce (dropping 10) (+) 0 input) 56 | 57 | should_pipe_from_left_to_right : List Int -> Test 58 | should_pipe_from_left_to_right input = 59 | assertEq 60 | (foldl (+) 0 (map (+1) (concatMap twice (filter odd input)))) 61 | (transduce (filtering odd . catMapping twice . mapping (+1)) (+) 0 input) 62 | 63 | should_allow_pure_xf_composition : Test 64 | should_allow_pure_xf_composition = 65 | let xf = taking 10 . filtering odd . mapping (*2) 66 | in do 67 | assertEq 50 (transduce xf (+) 0 [1..100]) 68 | assertEq 30240 (transduce xf (*) 1 [1..100]) 69 | assertEq 0 (transduce (mapping length . mapping fromNat . xf) (+) 0 (replicate 100 "ab")) 70 | 71 | should_index : Test 72 | should_index = do 73 | let xf = indexing . mapping (\(idx, s) => show idx ++ ": " ++ s) . interspersing ", " 74 | assertEq "0: Zero, 1: One, 2: Two" (transduce xf (++) "" ["Zero", "One", "Two"]) 75 | 76 | should_chunk_of : Test 77 | should_chunk_of = do 78 | let xf = chunksOf 4 . mapping pack . mapping (++ " ") 79 | assertEq "abcd efgh ijkl " (transduce xf (++) "" ['a'..'l']) 80 | assertEq "abcd efgh ij " (transduce xf (++) "" ['a'..'j']) 81 | 82 | should_intersperse : Test 83 | should_intersperse = do 84 | let cs = ["a", "list", "of", "words"] 85 | assertEq "a, list, of, words" (transduce (interspersing ", ") (++) "" cs) 86 | 87 | should_deduplicate : Test 88 | should_deduplicate = do 89 | assertEq "abcdcbad" $ transduce (mapping singleton . deduplicate) (++) "" (unpack "abbcddccbaad") 90 | 91 | should_group_by : Test 92 | should_group_by = 93 | assertEq ["aa", "b", "ccc", "b"] $ 94 | reverse $ into [] (groupingBy (==) . mapping pack) (unpack "aabcccb") 95 | 96 | should_group_by_with_custom_predicate : Test 97 | should_group_by_with_custom_predicate = 98 | assertEq 3 $ longestIncreasingSeq [1, 2, 1, 3, 4, 1, 5, 3, 4] 99 | where 100 | longestIncreasingSeq = transduce (groupingBy (<) . mapping length . mapping fromNat) max 0 101 | 102 | should_support_isomorphisms : Test 103 | should_support_isomorphisms = 104 | assertEq "ei" $ 105 | into "" (under (MkIso ord chr) (mapping (+1)) . filtering vowel) (unpack "abcdefgh") 106 | 107 | export 108 | run_tests : IO () 109 | run_tests = 110 | runTestSuite [ 111 | should_map [1..100], 112 | should_follow_map_law, 113 | should_filter [1..100], 114 | should_concat_map [1..100], 115 | should_reduce_terminal [1..100], 116 | should_take [1..100], 117 | should_take_while, 118 | should_drop [1..100], 119 | should_pipe_from_left_to_right [1..100], 120 | should_allow_pure_xf_composition, 121 | should_index, 122 | should_chunk_of, 123 | should_intersperse, 124 | should_deduplicate, 125 | should_group_by, 126 | should_group_by_with_custom_predicate, 127 | should_support_isomorphisms] 128 | -------------------------------------------------------------------------------- /src/Test/Transducers/Examples.idr: -------------------------------------------------------------------------------- 1 | module Test.Transducers.Examples 2 | 3 | import Control.Monad.State 4 | import Transducers 5 | import Test.Transducers.Utils 6 | 7 | 8 | -------------------------------------------------------------------------------- 9 | 10 | sumLength : StatelessStep Int String 11 | sumLength totalLength str = totalLength + fromNat (length str) 12 | 13 | test_sumLength : Test 14 | test_sumLength = 15 | assertEq 10 (foldl sumLength 0 ["abc", "de", "", "fghij"]) 16 | 17 | -------------------------------------------------------------------------------- 18 | 19 | sumLengthOfEveryOddStrings : Step Bool Int String 20 | sumLengthOfEveryOddStrings totalLength str = do 21 | doSum <- get 22 | modify not 23 | pure $ if doSum 24 | then Continue (sumLength totalLength str) 25 | else Continue (totalLength) 26 | 27 | test_sumLengthOfEveryOddStrings : Test 28 | test_sumLengthOfEveryOddStrings = do 29 | assertEq 6 $ 30 | reduce (MkReducer True sumLengthOfEveryOddStrings (const id)) 0 ["abc", "de", "", "fg", "hij"] 31 | 32 | -------------------------------------------------------------------------------- 33 | 34 | sumLengthUntil : Int -> Step () Int String 35 | sumLengthUntil maxValue totalLength str = 36 | pure $ if totalLength <= maxValue 37 | then Continue (sumLength totalLength str) 38 | else Done totalLength 39 | 40 | test_sumLengthUntil : Test 41 | test_sumLengthUntil = do 42 | assertEq 7 $ 43 | reduce (MkReducer () (sumLengthUntil 5) (const id)) 0 ["abc", "de", "", "fg", "hij"] 44 | 45 | -------------------------------------------------------------------------------- 46 | 47 | sumSquaresOfOdds : List Int -> Int 48 | sumSquaresOfOdds = transduce (filtering odd . mapping (\x => x * x)) (+) 0 49 | 50 | test_sumSquaresOfOdds : Test 51 | test_sumSquaresOfOdds = 52 | assertEq (1 + 9 + 25 + 49 + 81) $ sumSquaresOfOdds [1..10] 53 | 54 | -------------------------------------------------------------------------------- 55 | 56 | unwordSmallNames : Nat -> List String -> String 57 | unwordSmallNames maxLength strings = 58 | transduce (filtering smallStrings . interspersing " ") (++) "" strings 59 | where smallStrings s = length s <= maxLength 60 | 61 | test_unwordSmallNames : Test 62 | test_unwordSmallNames = 63 | assertEq "a bbbb ddd e" $ unwordSmallNames 4 (words "a bbbb ccccc ddd e") 64 | 65 | -------------------------------------------------------------------------------- 66 | 67 | startsWith : Char -> String -> Bool 68 | startsWith c str = 69 | if length str == 0 then False else strHead str == c 70 | 71 | -------------------------------------------------------------------------------- 72 | 73 | export 74 | run_tests : IO () 75 | run_tests = 76 | runTestSuite [ 77 | test_sumSquaresOfOdds, 78 | test_unwordSmallNames, 79 | test_sumLength, 80 | test_sumLengthOfEveryOddStrings] 81 | -------------------------------------------------------------------------------- /src/Test/Transducers/Utils.idr: -------------------------------------------------------------------------------- 1 | module Test.Transducers.Utils 2 | 3 | import System 4 | 5 | %access public export 6 | 7 | Test : Type 8 | Test = IO Int 9 | 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 | assertEq : (Eq a, Show a) => (expected : a) -> (given : a) -> Test 17 | assertEq e g = 18 | assertThat (g == e) $ 19 | "Expected == " ++ show e ++ ", Got: " ++ show g 20 | 21 | runTests : List Test -> Test 22 | runTests = foldl (\res, t => (+) <$> res <*> t) (pure 0) 23 | 24 | runTestSuite : List Test -> IO () 25 | runTestSuite tests = do 26 | failedCount <- runTests tests 27 | if failedCount > 0 28 | then exitFailure 29 | else pure () 30 | 31 | odd : Int -> Bool 32 | odd n = mod n 2 == 1 33 | 34 | twice : Int -> List Int 35 | twice = replicate 2 36 | 37 | vowel : Char -> Bool 38 | vowel c = c `elem` (unpack "aeiou") 39 | -------------------------------------------------------------------------------- /src/Transducers.idr: -------------------------------------------------------------------------------- 1 | module Transducers 2 | 3 | import public Transducers.Algorithms 4 | import public Transducers.Core 5 | import public Transducers.Utils 6 | -------------------------------------------------------------------------------- /src/Transducers/Algorithms.idr: -------------------------------------------------------------------------------- 1 | module Transducers.Algorithms 2 | 3 | 4 | import Control.Monad.State 5 | import Transducers.Core 6 | 7 | -------------------------------------------------------------------------------- 8 | -- Basic Transducers (stateless) 9 | -------------------------------------------------------------------------------- 10 | 11 | export 12 | mapping : (a -> b) -> Transducer acc s s a b 13 | mapping fn = statelessTransducer $ \next, acc, outer => next acc (fn outer) 14 | 15 | export 16 | filtering : (a -> Bool) -> Transducer acc s s a a 17 | filtering pf = statelessTransducer $ 18 | \next, acc, a => 19 | if pf a 20 | then next acc a 21 | else pure (Continue acc) 22 | 23 | export 24 | catMapping : (Foldable t) => (a -> t b) -> Transducer acc s s a b 25 | catMapping fn = statelessTransducer $ 26 | \next, acc, a => runSteps next acc (fn a) 27 | 28 | export 29 | takingWhile : (a -> Bool) -> Transducer acc s s a a 30 | takingWhile p = statelessTransducer $ 31 | \next, acc, a => do 32 | if p a 33 | then next acc a 34 | else pure (Done acc) 35 | 36 | 37 | -------------------------------------------------------------------------------- 38 | -- Basic Transducers (stateful) 39 | -------------------------------------------------------------------------------- 40 | 41 | export 42 | dropping : Nat -> Transducer acc s (Nat, s) a a 43 | dropping n = statefulTransducer n dropImpl 44 | where 45 | dropImpl next (S n, acc) _ = pure $ Continue (n, acc) 46 | dropImpl next (Z, acc) a = withState Z <$> next acc a 47 | 48 | export 49 | taking : Nat -> Transducer acc s (Nat, s) a a 50 | taking n = statefulTransducer n takeImpl 51 | where 52 | takeImpl next (Z, acc) a = pure (Done (Z, acc)) 53 | takeImpl next (n, acc) a = withState (pred n) <$> next acc a 54 | 55 | export 56 | interspersing : a -> Transducer acc s (Bool, s) a a 57 | interspersing separator = statefulTransducer False stepImpl 58 | where 59 | stepImpl next (False, acc) a = withState True <$> next acc a 60 | stepImpl next (True, acc) a = 61 | withState True <$> runSteps next acc [separator, a] 62 | 63 | export 64 | indexingFrom : Int -> Transducer acc s (Int, s) a (Int, a) 65 | indexingFrom startIndex = statefulTransducer startIndex stepImpl 66 | where 67 | stepImpl next (n, acc) a = withState (succ n) <$> next acc (n, a) 68 | 69 | export 70 | indexing : Transducer acc s (Int, s) a (Int, a) 71 | indexing = indexingFrom 0 72 | 73 | export 74 | chunksOf : Nat -> Transducer acc s (List a, s) a (List a) 75 | chunksOf chunkSize = makeTransducer [] nextChunk dumpRemaining 76 | where 77 | nextChunk next (remaining, acc) a = 78 | let remaining' = a :: remaining in 79 | if length remaining' == chunkSize 80 | then withState [] <$> next acc (reverse remaining') 81 | else pure $ Continue (remaining', acc) 82 | dumpRemaining next remaining acc = 83 | if isNil remaining 84 | then pure acc 85 | else unStatus <$> next acc (reverse remaining) 86 | 87 | export 88 | deduplicate : (Eq a) => Transducer acc s (Maybe a, s) a a 89 | deduplicate = statefulTransducer Nothing stepImpl 90 | where 91 | stepImpl next (oldVal, acc) a = 92 | if oldVal == Just a 93 | then pure $ Continue (oldVal, acc) 94 | else withState (Just a) <$> next acc a 95 | 96 | export 97 | groupingBy : (a -> a -> Bool) -> Transducer acc s (List a, s) a (List a) 98 | groupingBy sameGroup = makeTransducer [] stepImpl dumpRemaining 99 | where 100 | stepImpl next (previousVals, acc) a = 101 | case nonEmpty previousVals of 102 | No _ => pure $ Continue ([a], acc) 103 | Yes _ => if sameGroup (head previousVals) a -- Maintain stable order 104 | then pure $ Continue (a :: previousVals, acc) 105 | else withState [a] <$> next acc (reverse previousVals) 106 | dumpRemaining next remaining acc = 107 | if isNil remaining 108 | then pure acc 109 | else unStatus <$> next acc (reverse remaining) 110 | 111 | 112 | -------------------------------------------------------------------------------- 113 | -- Higher order transducers 114 | -------------------------------------------------------------------------------- 115 | 116 | public export 117 | record Iso a b where 118 | constructor MkIso 119 | toIso : a -> b 120 | fromIso : b -> a 121 | 122 | export 123 | under : Iso a b -> Transducer acc s1 s2 b b -> Transducer acc s1 s2 a a 124 | under iso xf = mapping (toIso iso) . xf . mapping (fromIso iso) 125 | -------------------------------------------------------------------------------- /src/Transducers/Core.idr: -------------------------------------------------------------------------------- 1 | module Transducers.Core 2 | 3 | import Control.Monad.State 4 | 5 | 6 | -------------------------------------------------------------------------------- 7 | -- Core (definition of steps, reducers and transducers) 8 | -------------------------------------------------------------------------------- 9 | 10 | public export 11 | data Status a = Done a | Continue a 12 | 13 | export 14 | unStatus : Status a -> a 15 | unStatus (Done a) = a 16 | unStatus (Continue a) = a 17 | 18 | export 19 | implementation Functor Status where 20 | map f (Done a) = Done (f a) 21 | map f (Continue a) = Continue (f a) 22 | 23 | public export 24 | StatelessStep : (acc, x: Type) -> Type 25 | StatelessStep acc x = acc -> x -> acc 26 | 27 | public export 28 | Step : (state, acc, x: Type) -> Type 29 | Step state acc x = acc -> x -> State state (Status acc) 30 | 31 | public export 32 | record Reducer st acc x where 33 | constructor MkReducer 34 | state : st 35 | runStep : Step st acc x 36 | complete : st -> acc -> acc 37 | 38 | export 39 | terminal : StatelessStep acc x -> Reducer () acc x 40 | terminal fn = MkReducer () step (const id) 41 | where step acc x = pure $ Continue (fn acc x) 42 | 43 | public export 44 | Transducer : (acc, s1, s2, outer, inner: Type) -> Type 45 | Transducer acc s1 s2 outer inner = Reducer s1 acc inner -> Reducer s2 acc outer 46 | 47 | 48 | -------------------------------------------------------------------------------- 49 | -- Helpers to build stateless Reducers and Transducers 50 | -------------------------------------------------------------------------------- 51 | 52 | export 53 | statelessTransducer : (Step s acc b -> Step s acc a) -> Transducer acc s s a b 54 | statelessTransducer stepTf next = 55 | MkReducer (state next) (stepTf (runStep next)) (complete next) 56 | 57 | export 58 | makeTransducer : 59 | s' 60 | -> (Step s acc b -> Step s (s', acc) a) 61 | -> (Step s acc b -> s' -> acc -> State s acc) 62 | -> Transducer acc s (s', s) a b 63 | makeTransducer initialState stepTf onComplete next = 64 | MkReducer (initialState, state next) stepImpl completeImpl 65 | where 66 | completeImpl (s', s) acc = 67 | let acc = evalState (onComplete (runStep next) s' acc) s 68 | in complete next s acc 69 | stepImpl acc x = do 70 | (s1', s1) <- get 71 | let (result, s2) = runState (stepTf (runStep next) (s1', acc) x) s1 72 | case result of 73 | Done (s2', acc) => do 74 | put (s2', s2) 75 | pure (Done acc) 76 | Continue (s2', acc) => do 77 | put (s2', s2) 78 | pure (Continue acc) 79 | 80 | export 81 | statefulTransducer : s' -> (Step s acc b -> Step s (s', acc) a) -> Transducer acc s (s', s) a b 82 | statefulTransducer initState stepTf = makeTransducer initState stepTf onComplete 83 | where 84 | onComplete next _ acc = pure acc 85 | 86 | export 87 | withState : s -> Status acc -> Status (s, acc) 88 | withState s = map (\acc => (s, acc)) 89 | 90 | 91 | -------------------------------------------------------------------------------- 92 | -- Core (Reductions) 93 | -------------------------------------------------------------------------------- 94 | 95 | export 96 | runSteps : (Foldable t) => Step st acc x -> acc -> t x -> State st (Status acc) 97 | runSteps step acc xs = foldr stepImpl (pure . id) xs (Continue acc) 98 | where 99 | stepImpl _ nextIteration (Done acc) = pure (Done acc) 100 | stepImpl x nextIteration (Continue acc) = step acc x >>= nextIteration 101 | 102 | export 103 | reduce : (Foldable t) => Reducer st acc x -> acc -> t x -> acc 104 | reduce step acc = 105 | uncurry (complete step) 106 | . (\(acc, s) => (s, unStatus acc)) 107 | . (flip runState (state step)) 108 | . runSteps (runStep step) acc 109 | 110 | export 111 | transduce : (Foldable t) => Transducer acc () s b a -> (acc -> a -> acc) -> acc -> t b -> acc 112 | transduce xf step = reduce (xf (terminal step)) 113 | -------------------------------------------------------------------------------- /src/Transducers/Utils.idr: -------------------------------------------------------------------------------- 1 | module Transducers.Utils 2 | 3 | import Transducers.Core 4 | 5 | 6 | -------------------------------------------------------------------------------- 7 | -- Utils to conjoin elements to a container 8 | -------------------------------------------------------------------------------- 9 | 10 | public export 11 | interface Conj xs x where 12 | conj : xs -> x -> xs 13 | 14 | export 15 | implementation Conj (List a) a where 16 | conj xs x = x :: xs 17 | 18 | export 19 | implementation Conj String Char where 20 | conj xs x = xs ++ singleton x 21 | 22 | 23 | -------------------------------------------------------------------------------- 24 | -- Utils to conjoin the result of a transduce into a container 25 | -------------------------------------------------------------------------------- 26 | 27 | export 28 | into : (Foldable t, Conj acc a) => acc -> Transducer acc () s b a -> t b -> acc 29 | into acc xf = transduce xf conj acc 30 | -------------------------------------------------------------------------------- /test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | idris --testpkg transducers.ipkg 4 | -------------------------------------------------------------------------------- /transducers.ipkg: -------------------------------------------------------------------------------- 1 | package transducers 2 | 3 | sourcedir = src 4 | 5 | modules = Transducers 6 | , Transducers.Algorithms 7 | , Transducers.Core 8 | , Transducers.Utils 9 | , Test.Transducers.Core 10 | , Test.Transducers.Examples 11 | , Test.Transducers.Utils 12 | 13 | tests = Test.Transducers.Core.run_tests 14 | , Test.Transducers.Examples.run_tests 15 | --------------------------------------------------------------------------------