├── .gitignore ├── shell.nix ├── elm.json ├── nix ├── sources.json └── sources.nix ├── CHANGELOG.md ├── tests ├── Recursion │ ├── TestTypes.elm │ ├── FoldTest.elm │ └── TraverseTest.elm └── RecursionTest.elm ├── review ├── elm.json └── src │ └── ReviewConfig.elm ├── LICENSE ├── README.md └── src ├── Recursion.elm └── Recursion ├── Fold.elm └── Traverse.elm /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff/ 2 | node_modules/ 3 | package.json 4 | package-lock.json 5 | .envrc 6 | .coverage -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | sources = import ./nix/sources.nix; 3 | nixpkgs = import sources.nixpkgs { }; 4 | in with nixpkgs; 5 | 6 | pkgs.mkShell { 7 | buildInputs = [ 8 | elmPackages.elm 9 | elmPackages.elm-format 10 | elmPackages.elm-test 11 | elmPackages.elm-doc-preview 12 | elmPackages.elm-json 13 | elmPackages.elm-review 14 | elmPackages.elm-coverage 15 | ]; 16 | } -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "micahhahn/elm-safe-recursion", 4 | "summary": "Elegant recursion in Elm without blowing the stack", 5 | "license": "BSD-3-Clause", 6 | "version": "2.0.0", 7 | "exposed-modules": [ 8 | "Recursion", 9 | "Recursion.Fold", 10 | "Recursion.Traverse" 11 | ], 12 | "elm-version": "0.19.0 <= v < 0.20.0", 13 | "dependencies": { 14 | "elm/core": "1.0.0 <= v < 2.0.0" 15 | }, 16 | "test-dependencies": { 17 | "elm-explorations/test": "1.2.2 <= v < 2.0.0" 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /nix/sources.json: -------------------------------------------------------------------------------- 1 | { 2 | "nixpkgs": { 3 | "branch": "release-22.05", 4 | "description": "Nix Packages collection", 5 | "homepage": "", 6 | "owner": "NixOS", 7 | "repo": "nixpkgs", 8 | "rev": "e8bc4c190a89b3d35d0a02be1a592470043daef7", 9 | "sha256": "049rj6mh14hb0q2p832qyy2j7miyd1jkfswnm3kqv4a0fx0x8601", 10 | "type": "tarball", 11 | "url": "https://github.com/NixOS/nixpkgs/archive/e8bc4c190a89b3d35d0a02be1a592470043daef7.tar.gz", 12 | "url_template": "https://github.com///archive/.tar.gz" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## [2.0.0] - 2022-09-01 4 | ### Changed 5 | - Completely gutted the underlying CPS implementation in favor of something much simpler and faster 6 | - The API has changed substantially: 7 | - We no longer provide left and right folds as we must always fold from the left anyways. The user can reverse the input if that behavior is required. 8 | - Dictionary folds now also have access to the key. 9 | - Many continuation accepting functions have been added (in the form of `___Then`) for performance. 10 | - New type variable letters have been chosen that should be more intuitive. 11 | 12 | ## [1.0.1] - 2022-07-28 13 | 14 | - Drastically improved documentation 15 | 16 | ## [1.0.0] - 2022-07-25 17 | 18 | - This is the first release of `elm-safe-recursion`. 19 | 20 | -------------------------------------------------------------------------------- /tests/Recursion/TestTypes.elm: -------------------------------------------------------------------------------- 1 | module Recursion.TestTypes exposing (ArrayTree(..), DictTree(..), ListTree(..), MaybeTree(..), ResultTree(..), hugeArrayTree, hugeDictTree, hugeListTree, hugeSize) 2 | 3 | import Array exposing (Array) 4 | import Dict exposing (Dict) 5 | 6 | 7 | hugeSize : Int 8 | hugeSize = 9 | 10000 10 | 11 | 12 | type ListTree a 13 | = ListNode a (List (ListTree a)) 14 | 15 | 16 | hugeListTree : ListTree Int 17 | hugeListTree = 18 | List.range 1 hugeSize 19 | |> List.map (\x -> ListNode x []) 20 | |> ListNode 0 21 | 22 | 23 | type DictTree a 24 | = DictNode a (Dict String (DictTree a)) 25 | 26 | 27 | hugeDictTree : DictTree Int 28 | hugeDictTree = 29 | List.range 1 hugeSize 30 | |> List.map (\x -> ( String.fromInt x, DictNode x Dict.empty )) 31 | |> Dict.fromList 32 | |> DictNode 0 33 | 34 | 35 | type ArrayTree a 36 | = ArrayNode a (Array (ArrayTree a)) 37 | 38 | 39 | hugeArrayTree : ArrayTree Int 40 | hugeArrayTree = 41 | List.range 1 hugeSize 42 | |> List.map (\x -> ArrayNode x (Array.fromList [])) 43 | |> Array.fromList 44 | |> ArrayNode 0 45 | 46 | 47 | type MaybeTree a 48 | = MaybeNode a (Maybe (MaybeTree a)) 49 | 50 | 51 | type ResultTree a 52 | = ResultNode a (Result String (ResultTree a)) 53 | -------------------------------------------------------------------------------- /review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/json": "1.1.3", 11 | "elm/project-metadata-utils": "1.0.2", 12 | "jfmengels/elm-review": "2.8.1", 13 | "jfmengels/elm-review-code-style": "1.0.0", 14 | "jfmengels/elm-review-common": "1.2.1", 15 | "jfmengels/elm-review-debug": "1.0.6", 16 | "jfmengels/elm-review-documentation": "2.0.1", 17 | "jfmengels/elm-review-simplify": "2.0.16", 18 | "jfmengels/elm-review-unused": "1.1.22", 19 | "stil4m/elm-syntax": "7.2.9" 20 | }, 21 | "indirect": { 22 | "elm/html": "1.0.0", 23 | "elm/parser": "1.1.0", 24 | "elm/random": "1.0.0", 25 | "elm/regex": "1.0.0", 26 | "elm/time": "1.0.0", 27 | "elm/virtual-dom": "1.0.3", 28 | "elm-community/list-extra": "8.6.0", 29 | "elm-explorations/test": "1.2.2", 30 | "miniBill/elm-unicode": "1.0.2", 31 | "rtfeldman/elm-hex": "1.0.0", 32 | "stil4m/structured-writer": "1.0.3" 33 | } 34 | }, 35 | "test-dependencies": { 36 | "direct": { 37 | "elm-explorations/test": "1.2.2" 38 | }, 39 | "indirect": {} 40 | } 41 | } -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2022, NoRedInk 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /tests/RecursionTest.elm: -------------------------------------------------------------------------------- 1 | module RecursionTest exposing (suite) 2 | 3 | import Expect 4 | import Recursion exposing (..) 5 | import Test exposing (..) 6 | 7 | 8 | slowSum1 : Int -> Float 9 | slowSum1 = 10 | runRecursion 11 | (\i -> 12 | case i of 13 | 0 -> 14 | base 0.0 15 | 16 | _ -> 17 | recurse (i - 1) |> map ((+) <| toFloat i) 18 | ) 19 | 20 | 21 | slowSum2 : Int -> Float 22 | slowSum2 = 23 | runRecursion 24 | (\i -> 25 | case i of 26 | 0 -> 27 | base 0.0 28 | 29 | _ -> 30 | recurse (i - 1) |> map ((+) <| toFloat i) 31 | ) 32 | 33 | 34 | slowSum3 : Int -> Float 35 | slowSum3 = 36 | runRecursion 37 | (\i -> 38 | case i of 39 | 0 -> 40 | base 0.0 41 | 42 | _ -> 43 | recurse (i - 1) |> andThen (\f -> base <| f + toFloat i) 44 | ) 45 | 46 | 47 | safetyTests : Test 48 | safetyTests = 49 | describe "Safety Tests" 50 | [ test "slowSum1 doesn't stack overflow" <| 51 | \_ -> 52 | slowSum1 100000 |> Expect.within (Expect.Absolute 0) ((100000.0 * 100001.0) / 2.0) 53 | , test "slowSum2 doesn't stack overflow" <| 54 | \_ -> 55 | slowSum2 100000 |> Expect.within (Expect.Absolute 0) ((100000.0 * 100001.0) / 2.0) 56 | , test "slowSum3 doesn't stack overflow" <| 57 | \_ -> 58 | slowSum3 100000 |> Expect.within (Expect.Absolute 0) ((100000.0 * 100001.0) / 2.0) 59 | ] 60 | 61 | 62 | suite : Test 63 | suite = 64 | describe "Recursion" 65 | [ safetyTests 66 | ] 67 | -------------------------------------------------------------------------------- /review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | {-| Do not rename the ReviewConfig module or the config function, because 4 | `elm-review` will look for these. 5 | 6 | To add packages that contain rules, add them to this review project using 7 | 8 | `elm install author/packagename` 9 | 10 | when inside the directory containing this file. 11 | 12 | -} 13 | 14 | 15 | import Docs.NoMissing exposing (exposedModules, onlyExposed) 16 | import Docs.ReviewAtDocs 17 | import Docs.ReviewLinksAndSections 18 | import Docs.UpToDateReadmeLinks 19 | import NoDebug.Log 20 | import NoDebug.TodoOrToString 21 | import NoExposingEverything 22 | import NoMissingTypeAnnotation 23 | import NoMissingTypeExpose 24 | import NoPrematureLetComputation 25 | import NoSimpleLetBody 26 | import NoUnused.CustomTypeConstructorArgs 27 | import NoUnused.CustomTypeConstructors 28 | import NoUnused.Dependencies 29 | import NoUnused.Exports 30 | import NoUnused.Modules 31 | import NoUnused.Parameters 32 | import NoUnused.Patterns 33 | import NoUnused.Variables 34 | import Review.Rule as Rule exposing (Rule) 35 | import Simplify 36 | 37 | 38 | config : List Rule 39 | config = 40 | [ Docs.NoMissing.rule 41 | { document = onlyExposed 42 | , from = exposedModules 43 | } 44 | , Docs.ReviewLinksAndSections.rule 45 | , Docs.ReviewAtDocs.rule 46 | , Docs.UpToDateReadmeLinks.rule 47 | , NoDebug.Log.rule 48 | , NoDebug.TodoOrToString.rule 49 | |> Rule.ignoreErrorsForDirectories [ "tests/" ] 50 | , NoExposingEverything.rule 51 | , NoMissingTypeAnnotation.rule 52 | , NoMissingTypeExpose.rule 53 | , NoSimpleLetBody.rule 54 | , NoPrematureLetComputation.rule 55 | , NoUnused.CustomTypeConstructors.rule [] 56 | , NoUnused.CustomTypeConstructorArgs.rule 57 | , NoUnused.Dependencies.rule 58 | , NoUnused.Exports.rule 59 | , NoUnused.Modules.rule 60 | , NoUnused.Parameters.rule 61 | , NoUnused.Patterns.rule 62 | , NoUnused.Variables.rule 63 | , Simplify.rule Simplify.defaults 64 | ] 65 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Safe and elegant recursion in Elm 2 | 3 | This package provides tools to use recursion safely in elm without sacrificing the elegance of general recursion. 4 | 5 | ## Example 6 | 7 | Imagine we have a generic tree type that we want to write a `map` function for: 8 | 9 | ```elm 10 | type Tree a 11 | = Leaf a 12 | | Node (Tree a) (Tree a) 13 | ``` 14 | 15 | The safe solution to implement a map function using this library would look like the following: 16 | 17 | ```elm 18 | mapTree : (a -> b) -> Tree a -> Tree b 19 | mapTree f initTree = 20 | runRecursion (\tree -> 21 | case tree of 22 | Leaf a -> 23 | base <| Leaf (f a) 24 | 25 | Node l r -> 26 | recurseThen l (\newL -> recurseThen r (\newR -> base (Node newL newR))) 27 | ) initTree 28 | ``` 29 | 30 | For more on the types and functions involved and details on how this works check out the [`Recursion`](https://package.elm-lang.org/packages/micahhahn/elm-safe-recursion/2.0.0/Recursion/) module. 31 | 32 | This module pairs extremely well with the elm-review rule [`NoUnoptimizedRecursion`](https://package.elm-lang.org/packages/jfmengels/elm-review-performance/latest/NoUnoptimizedRecursion). 33 | 34 | ## Can't I just... 35 | 36 | ### Refactor my recursive code by hand to be Tail Call Optimized? 37 | 38 | Sure! But for non-trivial recursions like the `mapTree` example above or recursive data structures involving lists you'll find yourself needing to write parallel data structures just to keep track of where you are in a step of the recursion. You quickly lose the elegance of recursion in all the bookkeeping. 39 | 40 | ### Use [elm-tail-recursion](https://package.elm-lang.org/packages/joneshf/elm-tail-recursion/latest/TailRecursion)? 41 | 42 | Sure! But again for non-trivial recursions you will require custom data structures and are only in a slightly better situation than writing tail call optimized code by hand. 43 | 44 | ### Use [trampoline](https://package.elm-lang.org/packages/elm-lang/trampoline/latest/Trampoline)? 45 | 46 | Sure! But it's the same situation as above. 47 | 48 | ## Additional Information 49 | 50 | This library is based on the excellent paper "Stackless Scala With Free Monads" by Bjarnason. Unfortunately, we don't have existentially quantified types in Elm so we can not directly implement the `Trampoline` monad from the paper as a dataype. 51 | 52 | We instead had to choose a different representation that unfortunately does not allow us to "disallow the construction of deeply nested left binds". To mitigate the risk of a user accidentally creating a stack of left binds, we provide safe implementations of folds and traversals for common data structures in [`Recursion.Fold`](https://package.elm-lang.org/packages/micahhahn/elm-safe-recursion/2.0.0/Recursion-Fold/) and [`Recursion.Traverse`](https://package.elm-lang.org/packages/micahhahn/elm-safe-recursion/2.0.0/Recursion-Traverse/). -------------------------------------------------------------------------------- /src/Recursion.elm: -------------------------------------------------------------------------------- 1 | module Recursion exposing 2 | ( Rec 3 | , base, recurse, recurseThen 4 | , map, andThen 5 | , runRecursion 6 | ) 7 | 8 | {-| This module provides an abstraction over general recursion that allows the recursive computation 9 | to be executed without risk of blowing the stack. 10 | 11 | If you are unfamiliar with why we need to be careful about unsafe recursion in Elm, 12 | [this article](https://functional-programming-in-elm.netlify.app/recursion/tail-call-elimination.html) describes the Tail-Call Elimination very well. 13 | 14 | It is not terribly difficult to rewrite simple recursions to be safe by taking advantage of the Tail Call Optimization. 15 | However, the moment you need to recurse on two or more elements in a data structure it becomes quite hairy to write safely 16 | and the resulting code loses much of the beauty of recursion. 17 | 18 | This module presents ways to create and execute the `Rec` monad, which is sufficiently powerful to represent non-simple recursion safely **and** will allow 19 | you to preserve the recursive elegance that makes functional programming beautiful. 20 | 21 | 22 | ## Core Type 23 | 24 | @docs Rec 25 | 26 | 27 | ## Creating a `Rec` 28 | 29 | @docs base, recurse, recurseThen 30 | 31 | 32 | ## Manipulating a `Rec` 33 | 34 | @docs map, andThen 35 | 36 | Check out [`Recursion.Traverse`](https://package.elm-lang.org/packages/micahhahn/elm-safe-recursion/2.0.0/Recursion-Traverse) 37 | and [`Recursion.Fold`](https://package.elm-lang.org/packages/micahhahn/elm-safe-recursion/2.0.0/Recursion-Fold) 38 | for helpers that work with containers of recursive types. 39 | 40 | 41 | ## Running a `Rec` 42 | 43 | @docs runRecursion 44 | 45 | 46 | # Example 47 | 48 | Imagine we have a generic binary tree type that we want to write a map function for: 49 | 50 | type Tree a 51 | = Leaf a 52 | | Node (Tree a) (Tree a) 53 | 54 | The standard recursive map algorithm is straightforward: 55 | 56 | mapTree : (a -> b) -> Tree a -> Tree b 57 | mapTree f tree = 58 | case tree of 59 | Leaf a -> 60 | Leaf (f a) 61 | 62 | Node l r -> 63 | Node (mapTree f l) (mapTree f r) 64 | 65 | ⚠️⚠️⚠️ This is unsafe! ⚠️⚠️⚠️ 66 | 67 | Since the recursive calls to `mapTree` are not located in tail call position the Tail Call Optimization will not fire. 68 | We are exposing ourselves to a crash if the tree is deep enough that we would have a stack overflow while executing it! 69 | 70 | 71 | ## Using elm-safe-recursion 72 | 73 | mapTree : (a -> b) -> Tree a -> Tree b 74 | mapTree f initTree = 75 | runRecursion 76 | (\tree -> 77 | case tree of 78 | Leaf a -> 79 | base (Leaf (f a)) 80 | 81 | Node l r -> 82 | recurseThen l 83 | (\newL -> 84 | recurseThen r 85 | (\newR -> 86 | baes <| Node newL newR 87 | ) 88 | ) 89 | ) 90 | initTree 91 | 92 | -} 93 | 94 | 95 | {-| An opaque type representing a recursive computation. 96 | 97 | - `r` is the **r**ecursive type. 98 | - `t` is the **t**arget type that we are converting to. 99 | - `a` is a type for intermediate parts of the computation. 100 | 101 | I think it is helpful to think of `Rec` like the `Promise` type in javascript. Simliar to a `Promise`, the 102 | result in a `Rec` value might not be available yet because it needs to recursively evaluated in a separate step. 103 | So instead of directly manipulating the value in a `Rec`, we instead can specify actions to be done with the value 104 | when it is available using `map` and `andThen`. 105 | 106 | -} 107 | type Rec r t a 108 | = Base a 109 | | Recurse r (t -> Rec r t a) 110 | 111 | 112 | {-| The base case of a recursion. The value is injected directly into the `Rec` type. 113 | -} 114 | base : a -> Rec r t a 115 | base = 116 | Base 117 | 118 | 119 | {-| Recurse on a value. 120 | 121 | When the recursion is complete the `Rec` will contain a value of type `t`. 122 | 123 | -} 124 | recurse : r -> Rec r t t 125 | recurse r = 126 | Recurse r base 127 | 128 | 129 | {-| Recurse on a value and then take another action on the result. 130 | 131 | If you find yourself writing code that looks like `recurse x |> andThen ...` or `recurse x |> map ...` you should 132 | consider using `recurseThen` instead as it will be much more efficient. 133 | 134 | -} 135 | recurseThen : r -> (t -> Rec r t a) -> Rec r t a 136 | recurseThen = 137 | Recurse 138 | 139 | 140 | {-| Apply a function to the result of a `Rec` computation. 141 | -} 142 | map : (a -> b) -> Rec r t a -> Rec r t b 143 | map f step = 144 | case step of 145 | Base t -> 146 | Base (f t) 147 | 148 | Recurse r after -> 149 | Recurse r (after >> map f) 150 | 151 | 152 | {-| Apply a function to the result of a `Rec` computation that can specify more recursion. 153 | -} 154 | andThen : (a -> Rec r t b) -> Rec r t a -> Rec r t b 155 | andThen next step = 156 | case step of 157 | Base t -> 158 | next t 159 | 160 | Recurse r after -> 161 | Recurse r (after >> andThen next) 162 | 163 | 164 | {-| Run a recursion given a function to run one layer and an initial value. 165 | -} 166 | runRecursion : (r -> Rec r t t) -> r -> t 167 | runRecursion project init = 168 | let 169 | go step stack = 170 | case step of 171 | Base t -> 172 | case stack of 173 | [] -> 174 | t 175 | 176 | next :: rest -> 177 | go (next t) rest 178 | 179 | Recurse r after -> 180 | go (project r) (after :: stack) 181 | in 182 | go (project init) [] 183 | -------------------------------------------------------------------------------- /tests/Recursion/FoldTest.elm: -------------------------------------------------------------------------------- 1 | module Recursion.FoldTest exposing (suite) 2 | 3 | import Array 4 | import Dict 5 | import Expect 6 | import Recursion exposing (..) 7 | import Recursion.Fold exposing (..) 8 | import Recursion.TestTypes exposing (..) 9 | import Test exposing (..) 10 | 11 | 12 | foldListCount : ListTree a -> Int 13 | foldListCount = 14 | runRecursion <| 15 | \(ListNode _ list) -> 16 | foldList (+) 1 list 17 | 18 | 19 | foldListThenCount : ListTree a -> Int 20 | foldListThenCount = 21 | runRecursion <| 22 | \(ListNode _ list) -> 23 | foldListThen (+) 1 list base 24 | 25 | 26 | foldMapListCount : ListTree a -> Int 27 | foldMapListCount = 28 | runRecursion <| 29 | \(ListNode _ list) -> 30 | foldMapList (\x accum -> recurseThen x ((+) accum >> base)) 1 list 31 | 32 | 33 | foldMapListThenCount : ListTree a -> Int 34 | foldMapListThenCount = 35 | runRecursion <| 36 | \(ListNode _ list) -> 37 | foldMapListThen (\x accum -> recurseThen x ((+) accum >> base)) 1 list base 38 | 39 | 40 | foldDictCount : DictTree a -> Int 41 | foldDictCount = 42 | runRecursion <| 43 | \(DictNode _ dict) -> 44 | foldDict (\_ x accum -> x + accum) 1 dict 45 | 46 | 47 | foldDictThenCount : DictTree a -> Int 48 | foldDictThenCount = 49 | runRecursion <| 50 | \(DictNode _ dict) -> 51 | foldDictThen (\_ x accum -> x + accum) 1 dict base 52 | 53 | 54 | foldMapDictCount : DictTree a -> Int 55 | foldMapDictCount = 56 | runRecursion <| 57 | \(DictNode _ dict) -> 58 | foldMapDict (\_ x accum -> recurseThen x ((+) accum >> base)) 1 dict 59 | 60 | 61 | foldMapDictThenCount : DictTree a -> Int 62 | foldMapDictThenCount = 63 | runRecursion <| 64 | \(DictNode _ dict) -> 65 | foldMapDictThen (\_ x accum -> recurseThen x ((+) accum >> base)) 1 dict base 66 | 67 | 68 | foldArrayCount : ArrayTree a -> Int 69 | foldArrayCount = 70 | runRecursion <| 71 | \(ArrayNode _ array) -> 72 | foldArray (+) 1 array 73 | 74 | 75 | foldArrayThenCount : ArrayTree a -> Int 76 | foldArrayThenCount = 77 | runRecursion <| 78 | \(ArrayNode _ array) -> 79 | foldArrayThen (+) 1 array base 80 | 81 | 82 | foldMapArrayCount : ArrayTree a -> Int 83 | foldMapArrayCount = 84 | runRecursion <| 85 | \(ArrayNode _ array) -> 86 | foldMapArray (\x accum -> recurseThen x ((+) accum >> base)) 1 array 87 | 88 | 89 | foldMapArrayThenCount : ArrayTree a -> Int 90 | foldMapArrayThenCount = 91 | runRecursion <| 92 | \(ArrayNode _ array) -> 93 | foldMapArrayThen (\x accum -> recurseThen x ((+) accum >> base)) 1 array base 94 | 95 | 96 | expectedHugeSize : Int 97 | expectedHugeSize = 98 | hugeSize + 1 99 | 100 | 101 | safetyTests : Test 102 | safetyTests = 103 | describe "Safety Tests" 104 | [ describe "List" 105 | [ test "foldList doesn't overflow" <| 106 | \_ -> 107 | foldListCount hugeListTree |> Expect.equal expectedHugeSize 108 | , test "foldListThen doesn't overflow" <| 109 | \_ -> 110 | foldListThenCount hugeListTree |> Expect.equal expectedHugeSize 111 | , test "foldMapList doesn't overflow" <| 112 | \_ -> 113 | foldMapListCount hugeListTree |> Expect.equal expectedHugeSize 114 | , test "foldMapListThen doesn't overflow" <| 115 | \_ -> 116 | foldMapListThenCount hugeListTree |> Expect.equal expectedHugeSize 117 | ] 118 | , describe "Dict" 119 | [ test "foldDict doesn't overflow" <| 120 | \_ -> 121 | foldDictCount hugeDictTree |> Expect.equal expectedHugeSize 122 | , test "foldDictThen doesn't overflow" <| 123 | \_ -> 124 | foldDictThenCount hugeDictTree |> Expect.equal expectedHugeSize 125 | , test "foldMapDict doesn't overflow" <| 126 | \_ -> 127 | foldMapDictCount hugeDictTree |> Expect.equal expectedHugeSize 128 | , test "foldMapDictThen doesn't overflow" <| 129 | \_ -> 130 | foldMapDictThenCount hugeDictTree |> Expect.equal expectedHugeSize 131 | ] 132 | , describe "Array" 133 | [ test "foldArray doesn't overflow" <| 134 | \_ -> 135 | foldArrayCount hugeArrayTree |> Expect.equal expectedHugeSize 136 | , test "foldArrayThen doesn't overflow" <| 137 | \_ -> 138 | foldArrayThenCount hugeArrayTree |> Expect.equal expectedHugeSize 139 | , test "foldMapArray doesn't overflow" <| 140 | \_ -> 141 | foldMapArrayCount hugeArrayTree |> Expect.equal expectedHugeSize 142 | , test "foldMapArrayThen doesn't overflow" <| 143 | \_ -> 144 | foldMapArrayThenCount hugeArrayTree |> Expect.equal expectedHugeSize 145 | ] 146 | ] 147 | 148 | 149 | correctnessTests : Test 150 | correctnessTests = 151 | describe "Correctness tests" 152 | [ describe "List" 153 | (let 154 | initListTree = 155 | ListNode 2 [ ListNode 1 [], ListNode 3 [] ] 156 | in 157 | [ test "foldList" <| \_ -> Expect.equal 3 (foldListCount initListTree) 158 | , test "foldListThen" <| \_ -> Expect.equal 3 (foldListThenCount initListTree) 159 | , test "foldMapList" <| \_ -> Expect.equal 3 (foldMapListCount initListTree) 160 | , test "foldMapListThen" <| \_ -> Expect.equal 3 (foldMapListThenCount initListTree) 161 | ] 162 | ) 163 | , describe "Dict" 164 | (let 165 | initDictTree = 166 | DictNode 2 (Dict.fromList [ ( "1", DictNode 1 Dict.empty ), ( "3", DictNode 3 Dict.empty ) ]) 167 | in 168 | [ test "foldDict" <| \_ -> Expect.equal 3 (foldDictCount initDictTree) 169 | , test "foldDictThen" <| \_ -> Expect.equal 3 (foldDictThenCount initDictTree) 170 | , test "foldMapDict" <| \_ -> Expect.equal 3 (foldMapDictCount initDictTree) 171 | , test "foldMapDictThen" <| \_ -> Expect.equal 3 (foldMapDictThenCount initDictTree) 172 | ] 173 | ) 174 | , describe "Array" 175 | (let 176 | initArrayTree = 177 | ArrayNode 2 (Array.fromList [ ArrayNode 1 Array.empty, ArrayNode 3 Array.empty ]) 178 | in 179 | [ test "sequenceArray" <| \_ -> Expect.equal 3 (foldArrayCount initArrayTree) 180 | , test "sequenceArrayThen" <| \_ -> Expect.equal 3 (foldArrayThenCount initArrayTree) 181 | , test "traverseArray" <| \_ -> Expect.equal 3 (foldMapArrayCount initArrayTree) 182 | , test "traverseArrayThen" <| \_ -> Expect.equal 3 (foldMapArrayThenCount initArrayTree) 183 | ] 184 | ) 185 | ] 186 | 187 | 188 | suite : Test 189 | suite = 190 | describe "Recursion.Fold" 191 | [ safetyTests 192 | , correctnessTests 193 | ] 194 | -------------------------------------------------------------------------------- /src/Recursion/Fold.elm: -------------------------------------------------------------------------------- 1 | module Recursion.Fold exposing 2 | ( foldList, foldListThen 3 | , foldMapList, foldMapListThen 4 | , foldDict, foldDictThen 5 | , foldMapDict, foldMapDictThen 6 | , foldArray, foldArrayThen 7 | , foldMapArray, foldMapArrayThen 8 | ) 9 | 10 | {-| This module contains functions for folding common collections types that can contain recursive data structures. 11 | 12 | Prefer to use the functions that accept a continuation when possible (`fold____Then`) as they will be more efficient than folding and then mapping after. 13 | 14 | 15 | # List 16 | 17 | @docs foldList, foldListThen 18 | @docs foldMapList, foldMapListThen 19 | 20 | 21 | # Dict 22 | 23 | @docs foldDict, foldDictThen 24 | @docs foldMapDict, foldMapDictThen 25 | 26 | 27 | # Array 28 | 29 | @docs foldArray, foldArrayThen 30 | @docs foldMapArray, foldMapArrayThen 31 | 32 | -} 33 | 34 | import Array exposing (Array) 35 | import Dict exposing (Dict) 36 | import Recursion exposing (..) 37 | 38 | 39 | {-| Fold a list of items which are recursive types. 40 | 41 | type RoseTree a 42 | = Leaf a 43 | | Node (List (RoseTree a)) 44 | 45 | countRoseTreeLeaves : RoseTree a -> Int 46 | countRoseTreeLeaves = 47 | runRecursion <| 48 | \tree -> 49 | case tree of 50 | Leaf _ -> 51 | base 1 52 | 53 | Node trees -> 54 | foldList (+) 0 trees 55 | 56 | -} 57 | foldList : (t -> a -> a) -> a -> List r -> Rec r t a 58 | foldList fold accum items = 59 | foldListThen fold accum items base 60 | 61 | 62 | {-| Fold a list of items which are recurisve types and then perform a recursive action with the result. 63 | -} 64 | foldListThen : (t -> a -> a) -> a -> List r -> (a -> Rec r t b) -> Rec r t b 65 | foldListThen fold accum items after = 66 | case items of 67 | [] -> 68 | after accum 69 | 70 | item :: rest -> 71 | recurseThen item (\t -> foldListThen fold (fold t accum) rest after) 72 | 73 | 74 | {-| Fold a list of items which contain recursive types. 75 | 76 | type KeyedRoseTree a 77 | = Leaf a 78 | | Node (List ( String, KeyedRoseTree a )) 79 | 80 | countRoseTreeLeaves : KeyedRoseTree a -> Int 81 | countRoseTreeLeaves = 82 | runRecursion <| 83 | \tree -> 84 | case tree of 85 | Leaf _ -> 86 | base 1 87 | 88 | Node trees -> 89 | foldMapList 90 | (\( _, rec ) count -> recurseMap rec ((+) count)) 91 | 0 92 | trees 93 | 94 | -} 95 | foldMapList : (x -> a -> Rec r t a) -> a -> List x -> Rec r t a 96 | foldMapList foldMap accum items = 97 | foldMapListThen foldMap accum items base 98 | 99 | 100 | {-| Fold a list of items which contain recursive types and then perform a recursive action with the result. 101 | -} 102 | foldMapListThen : (x -> a -> Rec r t a) -> a -> List x -> (a -> Rec r t b) -> Rec r t b 103 | foldMapListThen foldMap accum items after = 104 | case items of 105 | [] -> 106 | after accum 107 | 108 | item :: rest -> 109 | foldMap item accum |> andThen (\a -> foldMapListThen foldMap a rest after) 110 | 111 | 112 | {-| Fold a `Dict` whose values are recursive types. 113 | 114 | type HashTrie a 115 | = Leaf a 116 | | Node (Dict Char (HashTrie a)) 117 | 118 | countHashTrie : HashTrie a -> Int 119 | countHashTrie = 120 | runRecursion <| 121 | \tree -> 122 | case tree of 123 | Leaf _ -> 124 | base 1 125 | 126 | Node trees -> 127 | foldDict (\_ x count -> x + count) 0 trees 128 | 129 | -} 130 | foldDict : (comparable -> t -> a -> a) -> a -> Dict comparable r -> Rec r t a 131 | foldDict fold init dict = 132 | foldDictThen fold init dict base 133 | 134 | 135 | {-| Fold a `Dict` whose values are recursive types and then perform a recursive action with the result. 136 | -} 137 | foldDictThen : (comparable -> t -> a -> a) -> a -> Dict comparable r -> (a -> Rec r t b) -> Rec r t b 138 | foldDictThen fold init dict after = 139 | let 140 | go todo accum = 141 | case todo of 142 | [] -> 143 | after accum 144 | 145 | ( key, value ) :: rest -> 146 | recurseThen value (\t -> go rest (fold key t accum)) 147 | in 148 | go (Dict.toList dict) init 149 | 150 | 151 | {-| Fold a `Dict` whose values contain recursive types. 152 | 153 | type HashTrie a 154 | = Leaf a 155 | | Node (Dict Char ( Int, HashTrie a )) 156 | 157 | countHashTrie : HashTrie a -> Int 158 | countHashTrie = 159 | runRecursion <| 160 | \tree -> 161 | case tree of 162 | Leaf _ -> 163 | base 1 164 | 165 | Node trees -> 166 | foldMapDict (\_ ( _, v ) count -> recurseMap v (\x -> x + count)) 0 trees 167 | 168 | -} 169 | foldMapDict : (comparable -> v -> a -> Rec r t a) -> a -> Dict comparable v -> Rec r t a 170 | foldMapDict foldMap init dict = 171 | let 172 | go todo accum = 173 | case todo of 174 | [] -> 175 | base accum 176 | 177 | ( key, value ) :: rest -> 178 | foldMap key value accum |> andThen (go rest) 179 | in 180 | go (Dict.toList dict) init 181 | 182 | 183 | {-| Fold a `Dict` whose values contain recursive types and then perform a recursive action with the result. 184 | -} 185 | foldMapDictThen : (comparable -> v -> a -> Rec r t a) -> a -> Dict comparable v -> (a -> Rec r t b) -> Rec r t b 186 | foldMapDictThen foldMap init dict after = 187 | let 188 | go todo accum = 189 | case todo of 190 | [] -> 191 | after accum 192 | 193 | ( key, value ) :: rest -> 194 | foldMap key value accum |> andThen (go rest) 195 | in 196 | go (Dict.toList dict) init 197 | 198 | 199 | {-| Fold an `Array` whose items are recursive types. 200 | -} 201 | foldArray : (t -> a -> a) -> a -> Array r -> Rec r t a 202 | foldArray fold accum items = 203 | foldList fold accum (Array.toList items) 204 | 205 | 206 | {-| Fold an `Array` whose items are recursive types and then perform a recursive action with the result. 207 | -} 208 | foldArrayThen : (t -> a -> a) -> a -> Array r -> (a -> Rec r t b) -> Rec r t b 209 | foldArrayThen fold accum items after = 210 | foldListThen fold accum (Array.toList items) after 211 | 212 | 213 | {-| Fold an `Array` whose items contain recursive types. 214 | -} 215 | foldMapArray : (x -> a -> Rec r t a) -> a -> Array x -> Rec r t a 216 | foldMapArray foldMap accum items = 217 | foldMapList foldMap accum (Array.toList items) 218 | 219 | 220 | {-| Fold an `Array` whose items contain recursive types and then perform a recursive action with the result. 221 | -} 222 | foldMapArrayThen : (x -> a -> Rec r t a) -> a -> Array x -> (a -> Rec r t b) -> Rec r t b 223 | foldMapArrayThen foldMap accum items after = 224 | foldMapListThen foldMap accum (Array.toList items) after 225 | -------------------------------------------------------------------------------- /nix/sources.nix: -------------------------------------------------------------------------------- 1 | # This file has been generated by Niv. 2 | 3 | let 4 | 5 | # 6 | # The fetchers. fetch_ fetches specs of type . 7 | # 8 | 9 | fetch_file = pkgs: name: spec: 10 | let 11 | name' = sanitizeName name + "-src"; 12 | in 13 | if spec.builtin or true then 14 | builtins_fetchurl { inherit (spec) url sha256; name = name'; } 15 | else 16 | pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; 17 | 18 | fetch_tarball = pkgs: name: spec: 19 | let 20 | name' = sanitizeName name + "-src"; 21 | in 22 | if spec.builtin or true then 23 | builtins_fetchTarball { name = name'; inherit (spec) url sha256; } 24 | else 25 | pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; 26 | 27 | fetch_git = name: spec: 28 | let 29 | ref = 30 | if spec ? ref then spec.ref else 31 | if spec ? branch then "refs/heads/${spec.branch}" else 32 | if spec ? tag then "refs/tags/${spec.tag}" else 33 | abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!"; 34 | submodules = if spec ? submodules then spec.submodules else false; 35 | submoduleArg = 36 | let 37 | nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0; 38 | emptyArgWithWarning = 39 | if submodules == true 40 | then 41 | builtins.trace 42 | ( 43 | "The niv input \"${name}\" uses submodules " 44 | + "but your nix's (${builtins.nixVersion}) builtins.fetchGit " 45 | + "does not support them" 46 | ) 47 | {} 48 | else {}; 49 | in 50 | if nixSupportsSubmodules 51 | then { inherit submodules; } 52 | else emptyArgWithWarning; 53 | in 54 | builtins.fetchGit 55 | ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); 56 | 57 | fetch_local = spec: spec.path; 58 | 59 | fetch_builtin-tarball = name: throw 60 | ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. 61 | $ niv modify ${name} -a type=tarball -a builtin=true''; 62 | 63 | fetch_builtin-url = name: throw 64 | ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. 65 | $ niv modify ${name} -a type=file -a builtin=true''; 66 | 67 | # 68 | # Various helpers 69 | # 70 | 71 | # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695 72 | sanitizeName = name: 73 | ( 74 | concatMapStrings (s: if builtins.isList s then "-" else s) 75 | ( 76 | builtins.split "[^[:alnum:]+._?=-]+" 77 | ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name) 78 | ) 79 | ); 80 | 81 | # The set of packages used when specs are fetched using non-builtins. 82 | mkPkgs = sources: system: 83 | let 84 | sourcesNixpkgs = 85 | import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; 86 | hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; 87 | hasThisAsNixpkgsPath = == ./.; 88 | in 89 | if builtins.hasAttr "nixpkgs" sources 90 | then sourcesNixpkgs 91 | else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then 92 | import {} 93 | else 94 | abort 95 | '' 96 | Please specify either (through -I or NIX_PATH=nixpkgs=...) or 97 | add a package called "nixpkgs" to your sources.json. 98 | ''; 99 | 100 | # The actual fetching function. 101 | fetch = pkgs: name: spec: 102 | 103 | if ! builtins.hasAttr "type" spec then 104 | abort "ERROR: niv spec ${name} does not have a 'type' attribute" 105 | else if spec.type == "file" then fetch_file pkgs name spec 106 | else if spec.type == "tarball" then fetch_tarball pkgs name spec 107 | else if spec.type == "git" then fetch_git name spec 108 | else if spec.type == "local" then fetch_local spec 109 | else if spec.type == "builtin-tarball" then fetch_builtin-tarball name 110 | else if spec.type == "builtin-url" then fetch_builtin-url name 111 | else 112 | abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; 113 | 114 | # If the environment variable NIV_OVERRIDE_${name} is set, then use 115 | # the path directly as opposed to the fetched source. 116 | replace = name: drv: 117 | let 118 | saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name; 119 | ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; 120 | in 121 | if ersatz == "" then drv else 122 | # this turns the string into an actual Nix path (for both absolute and 123 | # relative paths) 124 | if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; 125 | 126 | # Ports of functions for older nix versions 127 | 128 | # a Nix version of mapAttrs if the built-in doesn't exist 129 | mapAttrs = builtins.mapAttrs or ( 130 | f: set: with builtins; 131 | listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) 132 | ); 133 | 134 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 135 | range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1); 136 | 137 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 138 | stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); 139 | 140 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 141 | stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); 142 | concatMapStrings = f: list: concatStrings (map f list); 143 | concatStrings = builtins.concatStringsSep ""; 144 | 145 | # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 146 | optionalAttrs = cond: as: if cond then as else {}; 147 | 148 | # fetchTarball version that is compatible between all the versions of Nix 149 | builtins_fetchTarball = { url, name ? null, sha256 }@attrs: 150 | let 151 | inherit (builtins) lessThan nixVersion fetchTarball; 152 | in 153 | if lessThan nixVersion "1.12" then 154 | fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) 155 | else 156 | fetchTarball attrs; 157 | 158 | # fetchurl version that is compatible between all the versions of Nix 159 | builtins_fetchurl = { url, name ? null, sha256 }@attrs: 160 | let 161 | inherit (builtins) lessThan nixVersion fetchurl; 162 | in 163 | if lessThan nixVersion "1.12" then 164 | fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) 165 | else 166 | fetchurl attrs; 167 | 168 | # Create the final "sources" from the config 169 | mkSources = config: 170 | mapAttrs ( 171 | name: spec: 172 | if builtins.hasAttr "outPath" spec 173 | then abort 174 | "The values in sources.json should not have an 'outPath' attribute" 175 | else 176 | spec // { outPath = replace name (fetch config.pkgs name spec); } 177 | ) config.sources; 178 | 179 | # The "config" used by the fetchers 180 | mkConfig = 181 | { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null 182 | , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile) 183 | , system ? builtins.currentSystem 184 | , pkgs ? mkPkgs sources system 185 | }: rec { 186 | # The sources, i.e. the attribute set of spec name to spec 187 | inherit sources; 188 | 189 | # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers 190 | inherit pkgs; 191 | }; 192 | 193 | in 194 | mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } 195 | -------------------------------------------------------------------------------- /src/Recursion/Traverse.elm: -------------------------------------------------------------------------------- 1 | module Recursion.Traverse exposing 2 | ( sequenceList, sequenceListThen 3 | , traverseList, traverseListThen 4 | , sequenceDict, sequenceDictThen 5 | , traverseDict, traverseDictThen 6 | , sequenceArray, sequenceArrayThen 7 | , traverseArray, traverseArrayThen 8 | , sequenceMaybe, sequenceMaybeThen 9 | , traverseMaybe, traverseMaybeThen 10 | , sequenceResult, sequenceResultThen 11 | , traverseResult, traverseResultThen 12 | ) 13 | 14 | {-| This module provides traversals for common data structures that contain recursive types. 15 | 16 | Prefer to use the functions that accept a continuation when possible (`sequence____Then` or `traverse____Then`) as they will be more efficient than folding and then mapping after. 17 | 18 | 19 | ### What is a traversal? 20 | 21 | A traversal is a transformation over a structure that **preserves the shape** of the structure. 22 | In this module, the traversal functions allow us to convert from a structure containing recursive types into a recursive type containing the structure. 23 | 24 | If you are trying to write a map function over a recursive data structure, a traversal is likely what you want. 25 | 26 | 27 | # List 28 | 29 | @docs sequenceList, sequenceListThen 30 | @docs traverseList, traverseListThen 31 | 32 | 33 | # Dict 34 | 35 | @docs sequenceDict, sequenceDictThen 36 | @docs traverseDict, traverseDictThen 37 | 38 | 39 | # Array 40 | 41 | @docs sequenceArray, sequenceArrayThen 42 | @docs traverseArray, traverseArrayThen 43 | 44 | 45 | # Maybe 46 | 47 | @docs sequenceMaybe, sequenceMaybeThen 48 | @docs traverseMaybe, traverseMaybeThen 49 | 50 | 51 | # Result 52 | 53 | @docs sequenceResult, sequenceResultThen 54 | @docs traverseResult, traverseResultThen 55 | 56 | -} 57 | 58 | import Array exposing (Array) 59 | import Dict exposing (Dict) 60 | import Recursion exposing (..) 61 | import Recursion.Fold exposing (..) 62 | 63 | 64 | {-| Traverse a list where the elements are recursive types. 65 | 66 | type RoseTree a 67 | = Node a (List (RoseTree a)) 68 | 69 | mapRoseTree : (a -> b) -> RoseTree a -> RoseTree b 70 | mapRoseTree f = 71 | runRecursion <| 72 | \(Node a nodes) -> 73 | sequenceList nodes 74 | |> map (Node (f a)) 75 | 76 | -} 77 | sequenceList : List r -> Rec r t (List t) 78 | sequenceList items = 79 | sequenceListThen items base 80 | 81 | 82 | {-| Traverse a list where the elements are recursive types and then perform a recursive action on the result. 83 | -} 84 | sequenceListThen : List r -> (List t -> Rec r t a) -> Rec r t a 85 | sequenceListThen items after = 86 | foldListThen (::) [] (List.reverse items) after 87 | 88 | 89 | {-| Traverse a list where the elements contain recursive types. 90 | 91 | type KeyedRoseTree a 92 | = Node a (List ( String, KeyedRoseTree a )) 93 | 94 | mapKeyedRoseTree : (a -> b) -> KeyedRoseTree a -> KeyedRoseTree b 95 | mapKeyedRoseTree f = 96 | runRecursion <| 97 | \(Node a nodes) -> 98 | traverseList (\( s, tree ) -> recurseMap tree (Tuple.pair s)) nodes 99 | |> map (Node (f a)) 100 | 101 | -} 102 | traverseList : (x -> Rec r t a) -> List x -> Rec r t (List a) 103 | traverseList project items = 104 | traverseListThen project items base 105 | 106 | 107 | {-| Traverse a list where the elements contain recursive types and then perform a recursive action on the result. 108 | -} 109 | traverseListThen : (x -> Rec r t a) -> List x -> (List a -> Rec r t b) -> Rec r t b 110 | traverseListThen project items after = 111 | let 112 | go accum todo = 113 | case todo of 114 | [] -> 115 | after <| List.reverse accum 116 | 117 | item :: rest -> 118 | project item |> andThen (\a -> go (a :: accum) rest) 119 | in 120 | go [] items 121 | 122 | 123 | {-| Traverse a `Dict` where the values are recursive types. 124 | 125 | type HashTrie a 126 | = Leaf a 127 | | Node (Dict Char (HashTrie a)) 128 | 129 | mapHashTrie : (a -> b) -> HashTrie a -> HashTrie b 130 | mapHashTrie f = 131 | runRecursion <| 132 | \tree -> 133 | case tree of 134 | Leaf a -> 135 | base (Leaf (f a)) 136 | 137 | Node dict -> 138 | sequenceDict dict 139 | |> map Node 140 | 141 | -} 142 | sequenceDict : Dict comparable r -> Rec r t (Dict comparable t) 143 | sequenceDict dict = 144 | sequenceDictThen dict base 145 | 146 | 147 | {-| Traverse a `Dict` where the values are recursive types and then perform a recursive action on the result. 148 | -} 149 | sequenceDictThen : Dict comparable r -> (Dict comparable t -> Rec r t a) -> Rec r t a 150 | sequenceDictThen dict after = 151 | let 152 | go accum todo = 153 | case todo of 154 | [] -> 155 | after (Dict.fromList accum) 156 | 157 | ( key, value ) :: rest -> 158 | recurseThen value (\t -> go (( key, t ) :: accum) rest) 159 | in 160 | go [] (Dict.toList dict) 161 | 162 | 163 | {-| Traverse a `Dict` where the values contain recursive types. 164 | -} 165 | traverseDict : (comparable -> v -> Rec r t a) -> Dict comparable v -> Rec r t (Dict comparable a) 166 | traverseDict project dict = 167 | traverseDictThen project dict base 168 | 169 | 170 | {-| Traverse a `Dict` where the values contain recursive types and then perform a recursive action the result. 171 | -} 172 | traverseDictThen : (comparable -> v -> Rec r t a) -> Dict comparable v -> (Dict comparable a -> Rec r t b) -> Rec r t b 173 | traverseDictThen project dict after = 174 | let 175 | go accum todo = 176 | case todo of 177 | [] -> 178 | after (Dict.fromList accum) 179 | 180 | ( key, value ) :: rest -> 181 | project key value |> andThen (\a -> go (( key, a ) :: accum) rest) 182 | in 183 | go [] (Dict.toList dict) 184 | 185 | 186 | {-| Traverse an `Array` where the values are recursive types. 187 | -} 188 | sequenceArray : Array r -> Rec r t (Array t) 189 | sequenceArray items = 190 | sequenceArrayThen items base 191 | 192 | 193 | {-| Traverse an `Array` where the values are recursive types and then perform a recursive action on the result. 194 | -} 195 | sequenceArrayThen : Array r -> (Array t -> Rec r t a) -> Rec r t a 196 | sequenceArrayThen items after = 197 | sequenceListThen (Array.toList items) (Array.fromList >> after) 198 | 199 | 200 | {-| Traverse an `Array` where the values contain recursive types. 201 | -} 202 | traverseArray : (x -> Rec r t a) -> Array x -> Rec r t (Array a) 203 | traverseArray project items = 204 | traverseArrayThen project items base 205 | 206 | 207 | {-| Traverse an `Array` where the values contain recursive types and then perform a recursive action on the result. 208 | -} 209 | traverseArrayThen : (x -> Rec r t a) -> Array x -> (Array a -> Rec r t b) -> Rec r t b 210 | traverseArrayThen project items after = 211 | traverseListThen project (Array.toList items) (Array.fromList >> after) 212 | 213 | 214 | {-| Traverse a `Maybe` where the value might be a recursive type. 215 | 216 | type NonEmpty a 217 | = NonEmpty a (Maybe (NonEmpty a)) 218 | 219 | mapNonEmpty : (a -> b) -> NonEmpty a -> NonEmpty b 220 | mapNonEmpty f = 221 | runRecursion <| 222 | \(NonEmpty v maybe) -> 223 | sequenceMaybe maybe 224 | |> map (NonEmpty (f v)) 225 | 226 | -} 227 | sequenceMaybe : Maybe r -> Rec r t (Maybe t) 228 | sequenceMaybe maybe = 229 | sequenceMaybeThen maybe base 230 | 231 | 232 | {-| Traverse a `Maybe` where the value might be a recursive type and then perform a recursive action on the result. 233 | -} 234 | sequenceMaybeThen : Maybe r -> (Maybe t -> Rec r t a) -> Rec r t a 235 | sequenceMaybeThen maybe after = 236 | case maybe of 237 | Nothing -> 238 | after Nothing 239 | 240 | Just r -> 241 | recurseThen r (Just >> after) 242 | 243 | 244 | {-| Traverse a `Maybe` where the value might contain a recursive type. 245 | 246 | type SeparatedList sep val 247 | = SeparatedList val (Maybe ( sep, SeparatedList sep val )) 248 | 249 | mapSeparatedList : (a -> b) -> SeparatedList sep a -> SeparatedList sep b 250 | mapSeparatedList f = 251 | runRecursion <| 252 | \(SeparatedList a maybeOthers) -> 253 | maybeOthers 254 | |> traverseMaybe (\( sep, sepList ) -> recurseMap sepList (Tuple.pair sep)) 255 | |> map (SeparatedList (f a)) 256 | 257 | -} 258 | traverseMaybe : (x -> Rec r t a) -> Maybe x -> Rec r t (Maybe a) 259 | traverseMaybe project maybe = 260 | traverseMaybeThen project maybe base 261 | 262 | 263 | {-| Traverse a `Maybe` where the value might contain a recursive type and then perform a recursive action on the result. 264 | -} 265 | traverseMaybeThen : (x -> Rec r t a) -> Maybe x -> (Maybe a -> Rec r t b) -> Rec r t b 266 | traverseMaybeThen project maybe after = 267 | case maybe of 268 | Nothing -> 269 | after Nothing 270 | 271 | Just x -> 272 | project x |> andThen (Just >> after) 273 | 274 | 275 | {-| Traverse a `Result` where the success value might be a recursive type. 276 | -} 277 | sequenceResult : Result e r -> Rec r t (Result e t) 278 | sequenceResult result = 279 | sequenceResultThen result base 280 | 281 | 282 | {-| Traverse a `Result` where the success value might be a recursive type and then perform an action on the recursive result. 283 | -} 284 | sequenceResultThen : Result e r -> (Result e t -> Rec r t a) -> Rec r t a 285 | sequenceResultThen result after = 286 | case result of 287 | Err err -> 288 | after (Err err) 289 | 290 | Ok a -> 291 | recurseThen a (Ok >> after) 292 | 293 | 294 | {-| Traverse a `Result` where the success value might contain a recursive type. 295 | -} 296 | traverseResult : (v -> Rec r t a) -> Result e v -> Rec r t (Result e a) 297 | traverseResult project result = 298 | case result of 299 | Err err -> 300 | base (Err err) 301 | 302 | Ok c -> 303 | project c |> map Ok 304 | 305 | 306 | {-| Traverse a `Result` where the success value might contain a recursive type and then perform an action on the recursive result. 307 | -} 308 | traverseResultThen : (v -> Rec r t a) -> Result e v -> (Result e a -> Rec r t b) -> Rec r t b 309 | traverseResultThen project result after = 310 | case result of 311 | Err err -> 312 | after (Err err) 313 | 314 | Ok c -> 315 | project c |> andThen (Ok >> after) 316 | -------------------------------------------------------------------------------- /tests/Recursion/TraverseTest.elm: -------------------------------------------------------------------------------- 1 | module Recursion.TraverseTest exposing (suite) 2 | 3 | import Array 4 | import Dict 5 | import Expect exposing (Expectation) 6 | import Recursion exposing (..) 7 | import Recursion.TestTypes exposing (..) 8 | import Recursion.Traverse exposing (..) 9 | import Test exposing (..) 10 | 11 | 12 | sequenceListMap : (a -> b) -> ListTree a -> ListTree b 13 | sequenceListMap f = 14 | runRecursion <| 15 | \(ListNode val list) -> 16 | sequenceList list |> map (ListNode (f val)) 17 | 18 | 19 | sequenceListThenMap : (a -> b) -> ListTree a -> ListTree b 20 | sequenceListThenMap f = 21 | runRecursion <| 22 | \(ListNode val list) -> 23 | sequenceListThen list (ListNode (f val) >> base) 24 | 25 | 26 | traverseListMap : (a -> b) -> ListTree a -> ListTree b 27 | traverseListMap f = 28 | runRecursion <| 29 | \(ListNode val list) -> 30 | traverseList recurse list |> map (ListNode (f val)) 31 | 32 | 33 | traverseListThenMap : (a -> b) -> ListTree a -> ListTree b 34 | traverseListThenMap f = 35 | runRecursion <| 36 | \(ListNode val list) -> 37 | traverseListThen recurse list (ListNode (f val) >> base) 38 | 39 | 40 | sequenceDictMap : (a -> b) -> DictTree a -> DictTree b 41 | sequenceDictMap f = 42 | runRecursion <| 43 | \(DictNode val dict) -> 44 | sequenceDict dict |> map (DictNode (f val)) 45 | 46 | 47 | sequenceDictThenMap : (a -> b) -> DictTree a -> DictTree b 48 | sequenceDictThenMap f = 49 | runRecursion <| 50 | \(DictNode val dict) -> 51 | sequenceDictThen dict (DictNode (f val) >> base) 52 | 53 | 54 | traverseDictMap : (a -> b) -> DictTree a -> DictTree b 55 | traverseDictMap f = 56 | runRecursion <| 57 | \(DictNode val dict) -> 58 | traverseDict (\_ v -> recurse v) dict |> map (DictNode (f val)) 59 | 60 | 61 | traverseDictThenMap : (a -> b) -> DictTree a -> DictTree b 62 | traverseDictThenMap f = 63 | runRecursion <| 64 | \(DictNode val dict) -> 65 | traverseDictThen (\_ v -> recurse v) dict (DictNode (f val) >> base) 66 | 67 | 68 | sequenceArrayMap : (a -> b) -> ArrayTree a -> ArrayTree b 69 | sequenceArrayMap f = 70 | runRecursion <| 71 | \(ArrayNode val array) -> 72 | sequenceArray array |> map (ArrayNode (f val)) 73 | 74 | 75 | sequenceArrayThenMap : (a -> b) -> ArrayTree a -> ArrayTree b 76 | sequenceArrayThenMap f = 77 | runRecursion <| 78 | \(ArrayNode val array) -> 79 | sequenceArrayThen array (ArrayNode (f val) >> base) 80 | 81 | 82 | traverseArrayMap : (a -> b) -> ArrayTree a -> ArrayTree b 83 | traverseArrayMap f = 84 | runRecursion <| 85 | \(ArrayNode val array) -> 86 | traverseArray recurse array |> map (ArrayNode (f val)) 87 | 88 | 89 | traverseArrayThenMap : (a -> b) -> ArrayTree a -> ArrayTree b 90 | traverseArrayThenMap f = 91 | runRecursion <| 92 | \(ArrayNode val array) -> 93 | traverseArrayThen recurse array (ArrayNode (f val) >> base) 94 | 95 | 96 | sequenceMaybeMap : (a -> b) -> MaybeTree a -> MaybeTree b 97 | sequenceMaybeMap f = 98 | runRecursion <| 99 | \(MaybeNode val array) -> 100 | sequenceMaybe array |> map (MaybeNode (f val)) 101 | 102 | 103 | sequenceMaybeThenMap : (a -> b) -> MaybeTree a -> MaybeTree b 104 | sequenceMaybeThenMap f = 105 | runRecursion <| 106 | \(MaybeNode val array) -> 107 | sequenceMaybeThen array (MaybeNode (f val) >> base) 108 | 109 | 110 | traverseMaybeMap : (a -> b) -> MaybeTree a -> MaybeTree b 111 | traverseMaybeMap f = 112 | runRecursion <| 113 | \(MaybeNode val array) -> 114 | traverseMaybe recurse array |> map (MaybeNode (f val)) 115 | 116 | 117 | traverseMaybeThenMap : (a -> b) -> MaybeTree a -> MaybeTree b 118 | traverseMaybeThenMap f = 119 | runRecursion <| 120 | \(MaybeNode val array) -> 121 | traverseMaybeThen recurse array (MaybeNode (f val) >> base) 122 | 123 | 124 | sequenceResultMap : (a -> b) -> ResultTree a -> ResultTree b 125 | sequenceResultMap f = 126 | runRecursion <| 127 | \(ResultNode val array) -> 128 | sequenceResult array |> map (ResultNode (f val)) 129 | 130 | 131 | sequenceResultThenMap : (a -> b) -> ResultTree a -> ResultTree b 132 | sequenceResultThenMap f = 133 | runRecursion <| 134 | \(ResultNode val array) -> 135 | sequenceResultThen array (ResultNode (f val) >> base) 136 | 137 | 138 | traverseResultMap : (a -> b) -> ResultTree a -> ResultTree b 139 | traverseResultMap f = 140 | runRecursion <| 141 | \(ResultNode val array) -> 142 | traverseResult recurse array |> map (ResultNode (f val)) 143 | 144 | 145 | traverseResultThenMap : (a -> b) -> ResultTree a -> ResultTree b 146 | traverseResultThenMap f = 147 | runRecursion <| 148 | \(ResultNode val array) -> 149 | traverseResultThen recurse array (ResultNode (f val) >> base) 150 | 151 | 152 | listTreeExists : ListTree a -> Expectation 153 | listTreeExists _ = 154 | Expect.pass 155 | 156 | 157 | dictTreeExists : DictTree a -> Expectation 158 | dictTreeExists _ = 159 | Expect.pass 160 | 161 | 162 | arrayTreeExists : ArrayTree a -> Expectation 163 | arrayTreeExists _ = 164 | Expect.pass 165 | 166 | 167 | stackSafetyTests : Test 168 | stackSafetyTests = 169 | describe "Stack Safety Tests" 170 | [ describe "List" 171 | [ test "sequenceList doesn't overflow" <| \_ -> sequenceListMap ((+) 1) hugeListTree |> listTreeExists 172 | , test "sequenceListThen doesn't overflow" <| \_ -> sequenceListThenMap ((+) 1) hugeListTree |> listTreeExists 173 | , test "traverseList doesn't overflow" <| \_ -> traverseListMap ((+) 1) hugeListTree |> listTreeExists 174 | , test "traverseListThen doesn't overflow" <| \_ -> traverseListThenMap ((+) 1) hugeListTree |> listTreeExists 175 | ] 176 | , describe "Dict" 177 | [ test "sequenceDict doesn't overflow" <| \_ -> sequenceDictMap ((+) 1) hugeDictTree |> dictTreeExists 178 | , test "sequenceDictThen doesn't overflow" <| \_ -> sequenceDictThenMap ((+) 1) hugeDictTree |> dictTreeExists 179 | , test "traverseDict doesn't overflow" <| \_ -> traverseDictMap ((+) 1) hugeDictTree |> dictTreeExists 180 | , test "traverseDictThen doesn't overflow" <| \_ -> traverseDictThenMap ((+) 1) hugeDictTree |> dictTreeExists 181 | ] 182 | , describe "Array" 183 | [ test "sequenceArray doesn't overflow" <| \_ -> sequenceArrayMap ((+) 1) hugeArrayTree |> arrayTreeExists 184 | , test "sequenceArrayThen doesn't overflow" <| \_ -> sequenceArrayThenMap ((+) 1) hugeArrayTree |> arrayTreeExists 185 | , test "traverseArray doesn't overflow" <| \_ -> traverseArrayMap ((+) 1) hugeArrayTree |> arrayTreeExists 186 | , test "traverseArrayThen doesn't overflow" <| \_ -> traverseArrayThenMap ((+) 1) hugeArrayTree |> arrayTreeExists 187 | ] 188 | ] 189 | 190 | 191 | correctnessTests : Test 192 | correctnessTests = 193 | describe "Correctness tests" 194 | [ describe "List" 195 | (let 196 | initListTree = 197 | ListNode 2 [ ListNode 1 [], ListNode 3 [] ] 198 | 199 | expectedListTree = 200 | ListNode 3 [ ListNode 2 [], ListNode 4 [] ] 201 | in 202 | [ test "sequenceList" <| \_ -> Expect.equal expectedListTree (sequenceListMap ((+) 1) initListTree) 203 | , test "sequenceListThen" <| \_ -> Expect.equal expectedListTree (sequenceListThenMap ((+) 1) initListTree) 204 | , test "traverseList" <| \_ -> Expect.equal expectedListTree (traverseListMap ((+) 1) initListTree) 205 | , test "traverseListThen" <| \_ -> Expect.equal expectedListTree (traverseListThenMap ((+) 1) initListTree) 206 | ] 207 | ) 208 | , describe "Dict" 209 | (let 210 | initDictTree = 211 | DictNode 2 (Dict.fromList [ ( "1", DictNode 1 Dict.empty ), ( "3", DictNode 3 Dict.empty ) ]) 212 | 213 | expectedDictTree = 214 | DictNode 3 (Dict.fromList [ ( "1", DictNode 2 Dict.empty ), ( "3", DictNode 4 Dict.empty ) ]) 215 | in 216 | [ test "sequenceDict" <| \_ -> Expect.equal expectedDictTree (sequenceDictMap ((+) 1) initDictTree) 217 | , test "sequenceDictThen" <| \_ -> Expect.equal expectedDictTree (sequenceDictThenMap ((+) 1) initDictTree) 218 | , test "traverseDict" <| \_ -> Expect.equal expectedDictTree (traverseDictMap ((+) 1) initDictTree) 219 | , test "traverseDictThen" <| \_ -> Expect.equal expectedDictTree (traverseDictThenMap ((+) 1) initDictTree) 220 | ] 221 | ) 222 | , describe "Array" 223 | (let 224 | initArrayTree = 225 | ArrayNode 2 (Array.fromList [ ArrayNode 1 Array.empty, ArrayNode 3 Array.empty ]) 226 | 227 | expectedArrayTree = 228 | ArrayNode 3 (Array.fromList [ ArrayNode 2 Array.empty, ArrayNode 4 Array.empty ]) 229 | in 230 | [ test "sequenceArray" <| \_ -> Expect.equal expectedArrayTree (sequenceArrayMap ((+) 1) initArrayTree) 231 | , test "sequenceArrayThen" <| \_ -> Expect.equal expectedArrayTree (sequenceArrayThenMap ((+) 1) initArrayTree) 232 | , test "traverseArray" <| \_ -> Expect.equal expectedArrayTree (traverseArrayMap ((+) 1) initArrayTree) 233 | , test "traverseArrayThen" <| \_ -> Expect.equal expectedArrayTree (traverseArrayThenMap ((+) 1) initArrayTree) 234 | ] 235 | ) 236 | , describe "Maybe" 237 | (let 238 | initMaybeTree = 239 | MaybeNode 1 (Just <| MaybeNode 2 (Just <| MaybeNode 3 Nothing)) 240 | 241 | expectedMaybeTree = 242 | MaybeNode 2 (Just <| MaybeNode 3 (Just <| MaybeNode 4 Nothing)) 243 | in 244 | [ test "sequenceMaybe" <| \_ -> Expect.equal expectedMaybeTree (sequenceMaybeMap ((+) 1) initMaybeTree) 245 | , test "sequenceMaybeThen" <| \_ -> Expect.equal expectedMaybeTree (sequenceMaybeThenMap ((+) 1) initMaybeTree) 246 | , test "traverseMaybe" <| \_ -> Expect.equal expectedMaybeTree (traverseMaybeMap ((+) 1) initMaybeTree) 247 | , test "traverseMaybeThen" <| \_ -> Expect.equal expectedMaybeTree (traverseMaybeThenMap ((+) 1) initMaybeTree) 248 | ] 249 | ) 250 | , describe "Result" 251 | (let 252 | initResultTree = 253 | ResultNode 1 (Ok <| ResultNode 2 (Ok <| ResultNode 3 (Err "a"))) 254 | 255 | expectedResultTree = 256 | ResultNode 2 (Ok <| ResultNode 3 (Ok <| ResultNode 4 (Err "a"))) 257 | in 258 | [ test "sequenceResult" <| \_ -> Expect.equal expectedResultTree (sequenceResultMap ((+) 1) initResultTree) 259 | , test "sequenceResultThen" <| \_ -> Expect.equal expectedResultTree (sequenceResultThenMap ((+) 1) initResultTree) 260 | , test "traverseResult" <| \_ -> Expect.equal expectedResultTree (traverseResultMap ((+) 1) initResultTree) 261 | , test "traverseResultThen" <| \_ -> Expect.equal expectedResultTree (traverseResultThenMap ((+) 1) initResultTree) 262 | ] 263 | ) 264 | ] 265 | 266 | 267 | suite : Test 268 | suite = 269 | describe "Recursion.Traverse" 270 | [ stackSafetyTests 271 | , correctnessTests 272 | ] 273 | --------------------------------------------------------------------------------