├── .gitignore ├── README.md ├── elm-package.json ├── src ├── MultiwayTree.elm └── MultiwayTreeZipper.elm └── tests ├── Test ├── AppendTests.elm ├── FilterTests.elm ├── FilterWithChildPrecedenceTests.elm ├── FlattenTests.elm ├── FoldTests.elm ├── IndexedMapTests.elm ├── InsertTests.elm ├── LengthTests.elm ├── MultiwayTreeZipper.elm ├── NavigationTests.elm ├── SampleData.elm ├── SortTests.elm ├── TuplesOfDatumAndFlatChildrenTests.elm ├── UpdateTests.elm └── Utils.elm ├── Tests.elm └── elm-package.json /.gitignore: -------------------------------------------------------------------------------- 1 | ################# 2 | ## Elm 3 | ################# 4 | elm-stuff/ 5 | elm.js 6 | tests/tests.js 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MultiwayTreeZipper 2 | 3 | This library was created with the goal of allowing a multiway tree to be 4 | navigated and updated. 5 | 6 | I ran into the problem when designing a tree UI control to use with The Elm 7 | Architecture. I realized that to keep track of the state in the model for things 8 | like whether a node is selected or expanded, I needed a way to update specific 9 | nodes through actions. 10 | 11 | There will be more examples to come, but this is meant as a library to solve a 12 | piece of the puzzle, which will be used with others to create a Tree UI control 13 | 14 | # Run tests (from a cloned repo) 15 | npm install -g elm 16 | cd tests 17 | elm-package install -y 18 | elm-make Tests.elm --output tests.js 19 | node tests.js 20 | 21 | NOTE: elm-test Tests.elm -c elm-make.cmd might have to be used if running on Windows. 22 | 23 | # Looking for Elm 0.19? 24 | 25 | I upgraded to the latest version of elm in a separate branch due to changes to both 26 | how dependencies are managed and tests are performed. That code lives in the [elm-0.19-upgrade][1] branch, and has been [deployed to Elm Packages][2] as version `1.10.3`. 27 | 28 | The API did not change, however, the custom operator that was demonstrated in docs 29 | and the tests, `(&>)` can no longer be used as of 0.19. I updated both to use the 30 | best concise alternative I could, which uses`|> Maybe.andThen` and partial application. 31 | See the test for an example! 32 | 33 | [1]: https://github.com/tomjkidd/elm-multiway-tree-zipper/tree/elm-0.19-upgrade 34 | [2]: https://package.elm-lang.org/packages/tomjkidd/elm-multiway-tree-zipper/1.10.3/ 35 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.10.2", 3 | "summary": "A library for navigating and updating immutable trees.", 4 | "repository": "https://github.com/tomjkidd/elm-multiway-tree-zipper.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | ".", 8 | "./src" 9 | ], 10 | "exposed-modules": [ 11 | "MultiwayTree", 12 | "MultiwayTreeZipper" 13 | ], 14 | "dependencies": { 15 | "elm-lang/core": "5.0.0 <= v < 6.0.0" 16 | }, 17 | "elm-version": "0.18.0 <= v < 0.19.0" 18 | } 19 | -------------------------------------------------------------------------------- /src/MultiwayTree.elm: -------------------------------------------------------------------------------- 1 | module MultiwayTree 2 | exposing 3 | ( Tree(..) 4 | , Forest 5 | , datum 6 | , children 7 | , map 8 | , mapListOverTree 9 | , indexedMap 10 | , filter 11 | , filterWithChildPrecedence 12 | , flatten 13 | , tuplesOfDatumAndFlatChildren 14 | , foldr 15 | , foldl 16 | , length 17 | , insertChild 18 | , appendChild 19 | , sortBy 20 | , sortWith 21 | ) 22 | 23 | {-| A library for constructing multi-way trees. Each Tree carries two pieces of 24 | information, it's datum and children. 25 | 26 | 27 | # Types 28 | @docs Tree, Forest 29 | 30 | # Operations 31 | @docs datum, children, foldl, foldr, flatten, tuplesOfDatumAndFlatChildren, filter, filterWithChildPrecedence, length, insertChild, appendChild 32 | 33 | # Mapping 34 | @docs map, mapListOverTree, indexedMap 35 | 36 | # Sorting 37 | @docs sortBy, sortWith 38 | -} 39 | 40 | 41 | {-| A type to keep track of datum and children. 42 | -} 43 | type Tree a 44 | = Tree a (Forest a) 45 | 46 | 47 | {-| A list of Trees. Convenient for describing children. 48 | -} 49 | type alias Forest a = 50 | List (Tree a) 51 | 52 | 53 | {-| Access the datum of the current tree 54 | -} 55 | datum : Tree a -> a 56 | datum (Tree datum children) = 57 | datum 58 | 59 | 60 | {-| Access the children of the current tree 61 | -} 62 | children : Tree a -> Forest a 63 | children (Tree datum children) = 64 | children 65 | 66 | 67 | {-| Inserts a Tree as the first child of a Tree 68 | -} 69 | insertChild : Tree a -> Tree a -> Tree a 70 | insertChild childTree (Tree datum children) = 71 | Tree datum (childTree :: children) 72 | 73 | 74 | {-| Inserts a Tree as the last child of a Tree 75 | -} 76 | appendChild : Tree a -> Tree a -> Tree a 77 | appendChild childTree (Tree datum children) = 78 | Tree datum (children ++ [ childTree ]) 79 | 80 | 81 | {-| Reduce a Tree from the left. 82 | -} 83 | foldl : (a -> b -> b) -> b -> Tree a -> b 84 | foldl f accu (Tree datum children) = 85 | let 86 | treeUnwrap (Tree datum_ children_) accu_ = 87 | List.foldl treeUnwrap (f datum_ accu_) children_ 88 | in 89 | List.foldl treeUnwrap (f datum accu) children 90 | 91 | 92 | {-| Reduce a Tree from the right. 93 | -} 94 | foldr : (a -> b -> b) -> b -> Tree a -> b 95 | foldr f accu (Tree datum children) = 96 | let 97 | treeUnwrap (Tree datum_ children_) accu_ = 98 | f datum_ (List.foldr treeUnwrap accu_ children_) 99 | in 100 | f datum (List.foldr treeUnwrap accu children) 101 | 102 | 103 | {-| Flattens a Tree into a List where the root is the first element of that list. 104 | -} 105 | flatten : Tree a -> List a 106 | flatten tree = 107 | foldr (::) [] tree 108 | 109 | 110 | {-| A special version of flatten which flattens a Tree into a List of Tuples like (element, [all elements in subtree]) 111 | 112 | (Tree.tuplesOfDatumAndFlatChildren 113 | Tree "a" 114 | [ Tree "b" [] 115 | , Tree "c" [] 116 | , Tree "d" [] 117 | ]) 118 | == [ ( "a", [ "b", "c", "d" ] ), ( "b", [] ), ( "c", [] ), ( "d", [] ) ] 119 | -} 120 | tuplesOfDatumAndFlatChildren : Tree a -> List ( a, List a ) 121 | tuplesOfDatumAndFlatChildren (Tree datum children) = 122 | [ ( datum, List.concatMap flatten children ) ] ++ (List.concatMap tuplesOfDatumAndFlatChildren children) 123 | 124 | 125 | {-| Return the length of the Tree. Calculated recusively as datum (1) + length of children (n) 126 | Since a MultiwayTree is never empty this function will never return Int < 1. 127 | -} 128 | length : Tree a -> Int 129 | length tree = 130 | foldr (\_ accu -> accu + 1) 0 tree 131 | 132 | 133 | {-| Map over the MultiwayTree 134 | -} 135 | map : (a -> b) -> Tree a -> Tree b 136 | map fn (Tree datum children) = 137 | let 138 | mappedDatum = 139 | fn datum 140 | 141 | mappedChildren = 142 | List.map (\child -> map fn child) children 143 | in 144 | (Tree mappedDatum mappedChildren) 145 | 146 | 147 | {-| Map a Function over a List and a MultiwayTree. 148 | -} 149 | mapListOverTree : (a -> b -> result) -> List a -> Tree b -> Maybe (Tree result) 150 | mapListOverTree fn list (Tree datum children) = 151 | case list of 152 | [] -> 153 | Nothing 154 | 155 | head :: [] -> 156 | let 157 | mappedDatum = 158 | fn head datum 159 | in 160 | Just (Tree mappedDatum []) 161 | 162 | head :: rest -> 163 | let 164 | mappedDatum = 165 | fn head datum 166 | 167 | listGroupedByLengthOfChildren = 168 | splitByLength (List.map length children) rest 169 | 170 | mappedChildren = 171 | List.map2 (\l child -> mapListOverTree fn l child) listGroupedByLengthOfChildren children 172 | |> List.filterMap identity 173 | in 174 | Just (Tree mappedDatum mappedChildren) 175 | 176 | 177 | splitByLength : List Int -> List a -> List (List a) 178 | splitByLength listOflengths list = 179 | splitByLength_ listOflengths list [] 180 | 181 | 182 | splitByLength_ : List Int -> List a -> List (List a) -> List (List a) 183 | splitByLength_ listOflengths list accu = 184 | case listOflengths of 185 | [] -> 186 | List.reverse accu 187 | 188 | currentLength :: restLengths -> 189 | case list of 190 | [] -> 191 | List.reverse accu 192 | 193 | head :: rest -> 194 | splitByLength_ restLengths (List.drop currentLength list) ((List.take currentLength list) :: accu) 195 | 196 | 197 | {-| Same as map but the function is also applied to the index of each element (starting at zero). 198 | -} 199 | indexedMap : (Int -> a -> b) -> Tree a -> Maybe (Tree b) 200 | indexedMap f tree = 201 | mapListOverTree f (List.range 0 (length tree - 1)) tree 202 | 203 | 204 | {-| Filter the MultiwayTree. Keep only elements whose datum satisfy the predicate. 205 | -} 206 | filter : (a -> Bool) -> Tree a -> Maybe (Tree a) 207 | filter predicate (Tree datum children) = 208 | if predicate datum then 209 | Just (Tree datum (List.filterMap (filter predicate) children)) 210 | else 211 | Nothing 212 | 213 | 214 | {-| Filter the MultiwayTree. If the predicate is True for a Child the entire path to the root will be part of the result Tree. 215 | -} 216 | filterWithChildPrecedence : (a -> Bool) -> Tree a -> Maybe (Tree a) 217 | filterWithChildPrecedence predicate (Tree datum children) = 218 | case List.filterMap (filterWithChildPrecedence predicate) children of 219 | [] -> 220 | if predicate datum then 221 | Just (Tree datum []) 222 | else 223 | Nothing 224 | 225 | children_ -> 226 | Just (Tree datum children_) 227 | 228 | 229 | {-| Sort values by a derived property. Does not alter the nesting structure of 230 | the Tree, that is it does not move Nodes up or down levels. 231 | 232 | (sortBy identity 233 | Tree "a" 234 | [ Tree "b" [] 235 | , Tree "d" [] 236 | , Tree "c" [] 237 | ]) 238 | == (Tree "a" 239 | [ Tree "b" [] 240 | , Tree "c" [] 241 | , Tree "d" [] 242 | ]) 243 | -} 244 | sortBy : (a -> comparable) -> Tree a -> Tree a 245 | sortBy fn (Tree datum children) = 246 | let 247 | sortedChildren = 248 | List.sortBy (\(Tree childDatum children_) -> fn childDatum) children 249 | |> List.map (sortBy fn) 250 | in 251 | (Tree datum sortedChildren) 252 | 253 | 254 | {-| Sort values with a custom comparison function like: 255 | 256 | flippedComparison a b = 257 | case compare a b of 258 | LT -> GT 259 | EQ -> EQ 260 | GT -> LT 261 | 262 | This is also the most general sort function, allowing you 263 | to define any other. 264 | -} 265 | sortWith : (a -> a -> Order) -> Tree a -> Tree a 266 | sortWith comperator (Tree datum children) = 267 | let 268 | sortedChildren = 269 | List.sortWith (\(Tree first _) (Tree second _) -> comperator first second) children 270 | |> List.map (sortWith comperator) 271 | in 272 | (Tree datum sortedChildren) 273 | -------------------------------------------------------------------------------- /src/MultiwayTreeZipper.elm: -------------------------------------------------------------------------------- 1 | module MultiwayTreeZipper 2 | exposing 3 | ( Context(..) 4 | , Breadcrumbs 5 | , Zipper 6 | , goToChild 7 | , goToRightMostChild 8 | , goUp 9 | , goLeft 10 | , goRight 11 | , goToRoot 12 | , goToNext 13 | , goToPrevious 14 | , goTo 15 | , updateDatum 16 | , replaceDatum 17 | , datum 18 | , maybeDatum 19 | , insertChild 20 | , appendChild 21 | , updateChildren 22 | ) 23 | 24 | {-| A library for navigating and updating immutable trees. The elements in 25 | the tree must have the same type. The trees are implemented in a Huet 26 | Zipper fashion. 27 | 28 | # Types 29 | @docs Context, Breadcrumbs, Zipper 30 | 31 | # Navigation API 32 | @docs goToChild, goUp, goToRoot, goLeft, goRight, goToNext, goToPrevious, goToRightMostChild, goTo 33 | 34 | # Update API 35 | @docs updateDatum, replaceDatum, insertChild, appendChild, updateChildren 36 | 37 | # Access API 38 | @docs datum, maybeDatum 39 | 40 | 41 | # References 42 | [The Zipper, Gerard Huet](https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf) 43 | [Learn You A Haskell, Zippers, Miran Lipovaca](http://learnyouahaskell.com/zippers) 44 | 45 | # Future work 46 | Might be able to integrate existing [Rose Tree](http://package.elm-lang.org/packages/TheSeamau5/elm-rosetree) to work with the Zipper. 47 | Wanted the first version to be self contained. 48 | 49 | -} 50 | 51 | -- TODO: Add more documentation 52 | 53 | import List 54 | import Maybe exposing (Maybe(..)) 55 | import MultiwayTree exposing (Tree(..), Forest, children, insertChild, appendChild) 56 | 57 | 58 | {-| The necessary information needed to reconstruct a MultiwayTree as it is 59 | navigated with a Zipper. This context includes the datum that was at the 60 | previous node, a list of children that came before the node, and a list of 61 | children that came after the node. 62 | -} 63 | type Context a 64 | = Context a (List (Tree a)) (List (Tree a)) 65 | 66 | 67 | {-| A list of Contexts that is contructed as a MultiwayTree is navigated. 68 | Breadcrumbs are used to retain information about parts of the tree that move out 69 | of focus. As the tree is navigated, the needed Context is pushed onto the list 70 | Breadcrumbs, and they are maintained in the reverse order in which they are 71 | visited 72 | -} 73 | type alias Breadcrumbs a = 74 | List (Context a) 75 | 76 | 77 | {-| A structure to keep track of the current Tree, as well as the Breadcrumbs to 78 | allow us to continue navigation through the rest of the tree. 79 | -} 80 | type alias Zipper a = 81 | ( Tree a, Breadcrumbs a ) 82 | 83 | 84 | {-| Separate a list into three groups. This function is unique to MultiwayTree 85 | needs. In order to navigate to children of any Tree, a way to break the children 86 | into pieces is needed. 87 | 88 | The pieces are: 89 | * before: The list of children that come before the desired child 90 | * focus: The desired child Tree 91 | * after: The list of children that come after the desired child 92 | 93 | These pieces help create a Context, which assist the Zipper 94 | -} 95 | splitOnIndex : Int -> List (Tree a) -> Maybe ( List (Tree a), Tree a, List (Tree a) ) 96 | splitOnIndex n xs = 97 | let 98 | before = 99 | List.take n xs 100 | 101 | focus = 102 | List.drop n xs |> List.head 103 | 104 | after = 105 | List.drop (n + 1) xs 106 | in 107 | case focus of 108 | Nothing -> 109 | Nothing 110 | 111 | Just f -> 112 | Just ( before, f, after ) 113 | 114 | 115 | {-| Move up relative to the current Zipper focus. This allows navigation from a 116 | child to it's parent. 117 | 118 | (&>) = flip Maybe.andThen 119 | 120 | simpleTree = 121 | Tree "a" 122 | [ Tree "b" [] 123 | , Tree "c" [] 124 | , Tree "d" [] 125 | ] 126 | 127 | Just (simpleTree, []) 128 | &> goToChild 0 129 | &> goUp 130 | -} 131 | goUp : Zipper a -> Maybe (Zipper a) 132 | goUp ( tree, breadcrumbs ) = 133 | case breadcrumbs of 134 | (Context datum before after) :: bs -> 135 | Just ( Tree datum (before ++ [ tree ] ++ after), bs ) 136 | 137 | [] -> 138 | Nothing 139 | 140 | 141 | {-| Move down relative to the current Zipper focus. This allows navigation from 142 | a parent to it's children. 143 | 144 | (&>) = flip Maybe.andThen 145 | 146 | simpleTree = 147 | Tree "a" 148 | [ Tree "b" [] 149 | , Tree "c" [] 150 | , Tree "d" [] 151 | ] 152 | 153 | Just (simpleTree, []) 154 | &> goToChild 1 155 | -} 156 | goToChild : Int -> Zipper a -> Maybe (Zipper a) 157 | goToChild n ( Tree datum children, breadcrumbs ) = 158 | let 159 | maybeSplit = 160 | splitOnIndex n children 161 | in 162 | case maybeSplit of 163 | Nothing -> 164 | Nothing 165 | 166 | Just ( before, focus, after ) -> 167 | Just ( focus, (Context datum before after) :: breadcrumbs ) 168 | 169 | 170 | {-| Move down and as far right as possible relative to the current Zipper focus. 171 | This allows navigation from a parent to it's last child. 172 | 173 | (&>) = flip Maybe.andThen 174 | 175 | simpleTree = 176 | Tree "a" 177 | [ Tree "b" [] 178 | , Tree "c" [] 179 | , Tree "d" [] 180 | ] 181 | 182 | Just (simpleTree, []) 183 | &> goToRightMostChild 184 | -} 185 | goToRightMostChild : Zipper a -> Maybe (Zipper a) 186 | goToRightMostChild ( Tree datum children, breadcrumbs ) = 187 | goToChild ((List.length children) - 1) ( Tree datum children, breadcrumbs ) 188 | 189 | 190 | {-| Move left relative to the current Zipper focus. This allows navigation from 191 | a child to it's previous sibling. 192 | 193 | (&>) = flip Maybe.andThen 194 | 195 | simpleTree = 196 | Tree "a" 197 | [ Tree "b" [] 198 | , Tree "c" [] 199 | , Tree "d" [] 200 | ] 201 | 202 | Just (simpleTree, []) 203 | &> goToChild 1 204 | &> goLeft 205 | -} 206 | goLeft : Zipper a -> Maybe (Zipper a) 207 | goLeft ( tree, breadcrumbs ) = 208 | case breadcrumbs of 209 | [] -> 210 | Nothing 211 | 212 | (Context datum before after) :: bs -> 213 | case List.reverse before of 214 | [] -> 215 | Nothing 216 | 217 | tree_ :: rest -> 218 | Just ( tree_, (Context datum (List.reverse rest) (tree :: after)) :: bs ) 219 | 220 | 221 | {-| Move right relative to the current Zipper focus. This allows navigation from 222 | a child to it's next sibling. 223 | 224 | (&>) = flip Maybe.andThen 225 | 226 | simpleTree = 227 | Tree "a" 228 | [ Tree "b" [] 229 | , Tree "c" [] 230 | , Tree "d" [] 231 | ] 232 | 233 | Just (simpleTree, []) 234 | &> goToChild 1 235 | &> goRight 236 | -} 237 | goRight : Zipper a -> Maybe (Zipper a) 238 | goRight ( tree, breadcrumbs ) = 239 | case breadcrumbs of 240 | (Context datum before after) :: bs -> 241 | case after of 242 | [] -> 243 | Nothing 244 | 245 | (Tree nextDatum nextChildren) :: rest -> 246 | Just ( (Tree nextDatum nextChildren), (Context datum (before ++ [ tree ]) rest) :: bs ) 247 | 248 | [] -> 249 | Nothing 250 | 251 | 252 | {-| Moves to the previous node in the hierarchy, depth-first. 253 | 254 | (&>) = flip Maybe.andThen 255 | 256 | simpleTree = 257 | Tree "a" 258 | [ Tree "b" [] 259 | , Tree "c" [] 260 | , Tree "d" [] 261 | ] 262 | 263 | Just (simpleTree, []) 264 | &> goToChild 2 265 | &> goToPrevious 266 | &> goToPrevious 267 | -} 268 | goToPrevious : Zipper a -> Maybe (Zipper a) 269 | goToPrevious zipper = 270 | let 271 | recurseDownAndRight zipper_ = 272 | case goToRightMostChild zipper_ of 273 | Just zipper__ -> 274 | recurseDownAndRight zipper__ 275 | 276 | Nothing -> 277 | Just zipper_ 278 | in 279 | case goLeft zipper of 280 | Just zipper_ -> 281 | recurseDownAndRight zipper_ 282 | 283 | Nothing -> 284 | goUp zipper 285 | 286 | 287 | {-| Moves to the next node in the hierarchy, depth-first. If already 288 | at the end, stays there. 289 | 290 | (&>) = flip Maybe.andThen 291 | 292 | simpleTree = 293 | Tree "a" 294 | [ Tree "b" [] 295 | , Tree "c" [] 296 | , Tree "d" [] 297 | ] 298 | 299 | Just (simpleTree, []) 300 | &> goToNext 301 | &> goToNext 302 | -} 303 | goToNext : Zipper a -> Maybe (Zipper a) 304 | goToNext zipper = 305 | let 306 | upAndOver zipper = 307 | case goUp zipper of 308 | Nothing -> 309 | Nothing 310 | 311 | Just zipper_ -> 312 | case goRight zipper_ of 313 | Nothing -> 314 | upAndOver zipper_ 315 | 316 | zipper__ -> 317 | zipper__ 318 | in 319 | case goToChild 0 zipper of 320 | Just zipper_ -> 321 | Just zipper_ 322 | 323 | Nothing -> 324 | case goRight zipper of 325 | Just zipper_ -> 326 | Just zipper_ 327 | 328 | Nothing -> 329 | case upAndOver zipper of 330 | Nothing -> 331 | Nothing 332 | 333 | zipper_ -> 334 | zipper_ 335 | 336 | 337 | {-| Move to the root of the current Zipper focus. This allows navigation from 338 | any part of the tree back to the root. 339 | 340 | (&>) = flip Maybe.andThen 341 | 342 | simpleTree = 343 | Tree "a" 344 | [ Tree "b" 345 | [ Tree "e" [] ] 346 | , Tree "c" [] 347 | , Tree "d" [] 348 | ] 349 | 350 | Just (simpleTree, []) 351 | &> goToChild 0 352 | &> goToChild 1 353 | &> goToRoot 354 | -} 355 | goToRoot : Zipper a -> Maybe (Zipper a) 356 | goToRoot ( tree, breadcrumbs ) = 357 | case breadcrumbs of 358 | [] -> 359 | Just ( tree, breadcrumbs ) 360 | 361 | otherwise -> 362 | goUp ( tree, breadcrumbs ) |> Maybe.andThen goToRoot 363 | 364 | 365 | {-| Move the focus to the first element for which the predicate is True. If no 366 | such element exists returns Nothing. Starts searching at the root of the tree. 367 | 368 | (&>) = flip Maybe.andThen 369 | 370 | simpleTree = 371 | Tree "a" 372 | [ Tree "b" 373 | [ Tree "e" [] ] 374 | , Tree "c" [] 375 | , Tree "d" [] 376 | ] 377 | 378 | Just (simpleTree, []) 379 | &> goTo (\elem -> elem == "e") 380 | -} 381 | goTo : (a -> Bool) -> Zipper a -> Maybe (Zipper a) 382 | goTo predicate zipper = 383 | let 384 | goToElementOrNext ( Tree datum children, breadcrumbs ) = 385 | if predicate datum then 386 | Just ( Tree datum children, breadcrumbs ) 387 | else 388 | goToNext ( Tree datum children, breadcrumbs ) |> Maybe.andThen goToElementOrNext 389 | in 390 | (goToRoot zipper) |> Maybe.andThen goToElementOrNext 391 | 392 | 393 | {-| Update the datum at the current Zipper focus. This allows changes to be made 394 | to a part of a node's datum information, given the previous state of the node. 395 | 396 | (&>) = flip Maybe.andThen 397 | 398 | simpleTree = 399 | Tree "a" 400 | [ Tree "b" 401 | [ Tree "e" [] ] 402 | , Tree "c" [] 403 | , Tree "d" [] 404 | ] 405 | 406 | Just (simpleTree, []) 407 | &> goToChild 0 408 | &> updateDatum (\old -> old ++ "X") -- Appends an X to "b" 409 | &> goToRoot 410 | -} 411 | updateDatum : (a -> a) -> Zipper a -> Maybe (Zipper a) 412 | updateDatum fn ( Tree datum children, breadcrumbs ) = 413 | Just ( Tree (fn datum) children, breadcrumbs ) 414 | 415 | 416 | {-| Replace the datum at the current Zipper focus. This allows complete 417 | replacement of a node's datum information, ignoring the previous state of the 418 | node. 419 | 420 | (&>) = flip Maybe.andThen 421 | 422 | simpleTree = 423 | Tree "a" 424 | [ Tree "b" 425 | [ Tree "e" [] ] 426 | , Tree "c" [] 427 | , Tree "d" [] 428 | ] 429 | 430 | Just (simpleTree, []) 431 | &> goToChild 0 432 | &> replaceDatum "X" -- Replaces "b" with "X" 433 | &> goToRoot 434 | -} 435 | replaceDatum : a -> Zipper a -> Maybe (Zipper a) 436 | replaceDatum newDatum = 437 | updateDatum (\_ -> newDatum) 438 | 439 | 440 | {-| Fully replace the children at the current Zipper focus. 441 | -} 442 | updateChildren : Forest a -> Zipper a -> Maybe (Zipper a) 443 | updateChildren newChildren ( Tree datum children, breadcrumbs ) = 444 | Just ( Tree datum newChildren, breadcrumbs ) 445 | 446 | 447 | {-| Inserts a Tree as the first child of the Tree at the current focus. Does not move the focus. 448 | -} 449 | insertChild : Tree a -> Zipper a -> Maybe (Zipper a) 450 | insertChild child ( tree, breadcrumbs ) = 451 | Just ( MultiwayTree.insertChild child tree, breadcrumbs ) 452 | 453 | 454 | {-| Inserts a Tree as the last child of the Tree at the current focus. Does not move the focus. 455 | -} 456 | appendChild : Tree a -> Zipper a -> Maybe (Zipper a) 457 | appendChild child ( tree, breadcrumbs ) = 458 | Just ( MultiwayTree.appendChild child tree, breadcrumbs ) 459 | 460 | 461 | {-| Access the datum at the current Zipper focus. 462 | -} 463 | datum : Zipper a -> a 464 | datum ( tree, breadcrumbs ) = 465 | MultiwayTree.datum tree 466 | 467 | 468 | {-| Access the datum at the current Zipper focus as a Maybe. 469 | -} 470 | maybeDatum : Zipper a -> Maybe a 471 | maybeDatum zipper = 472 | datum zipper 473 | |> Just 474 | -------------------------------------------------------------------------------- /tests/Test/AppendTests.elm: -------------------------------------------------------------------------------- 1 | module Test.AppendTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | import Test.Utils exposing (..) 16 | 17 | 18 | tests : Test 19 | tests = 20 | suite "Append" 21 | [ test "appending children can turn a multiChildTree into an interestingTree" <| 22 | assertEqual (Just ( interestingTree, [] )) 23 | (Just ( multiChildTree, [] ) 24 | &> goToChild 25 | 0 26 | &> appendChild (Tree "e" []) 27 | &> goToChild 0 28 | &> appendChild (Tree "k" []) 29 | &> goUp 30 | &> goRight 31 | &> appendChild (Tree "f" []) 32 | &> appendChild (Tree "g" []) 33 | &> goRight 34 | &> appendChild (Tree "h" []) 35 | &> appendChild (Tree "i" []) 36 | &> appendChild (Tree "j" []) 37 | &> goToRoot 38 | ) 39 | ] 40 | -------------------------------------------------------------------------------- /tests/Test/FilterTests.elm: -------------------------------------------------------------------------------- 1 | module Test.FilterTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "Filter" 20 | [ test "Filtering a Tree with a predicate that always returns true returns the same tree" 21 | <| assertEqual (Just interestingTree) 22 | (MultiwayTree.filter (\_ -> True) interestingTree) 23 | , test "Filtering a Tree with a predicate returns a filtered Tree" 24 | <| assertEqual (Just multiChildTree) 25 | (MultiwayTree.filter (\e -> e < "e") interestingTree) 26 | , test "If a subtree contains an element which would evaluate the predicate to True it is still not in the result Tree if the parent datum evaluates to false" 27 | <| assertEqual Nothing 28 | (MultiwayTree.filter (\e -> e == "k") interestingTree) 29 | ] 30 | -------------------------------------------------------------------------------- /tests/Test/FilterWithChildPrecedenceTests.elm: -------------------------------------------------------------------------------- 1 | module Test.FilterWithChildPrecedenceTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "Filter" 20 | [ test "Filtering a Tree with a predicate that always returns true returns the same tree" 21 | <| assertEqual (Just interestingTree) 22 | (MultiwayTree.filterWithChildPrecedence (\_ -> True) interestingTree) 23 | , test "Filtering a Tree with a predicate returns a filtered Tree" 24 | <| assertEqual (Just multiChildTree) 25 | (MultiwayTree.filterWithChildPrecedence (\e -> e < "e") interestingTree) 26 | , test "If an element is no where to be found in the tree returns Nothing" 27 | <| assertEqual Nothing 28 | (MultiwayTree.filterWithChildPrecedence (\e -> e == "fooo") interestingTree) 29 | , test "If a predicate evaluates to False for a Node but True for one of it's children then the Node will remain in the Tree" 30 | <| assertEqual 31 | (Just 32 | (Tree "a" 33 | [ Tree "b" 34 | [ Tree "e" 35 | [ Tree "k" [] ] 36 | ] 37 | ] 38 | ) 39 | ) 40 | (MultiwayTree.filterWithChildPrecedence (\e -> e == "k") interestingTree) 41 | ] 42 | -------------------------------------------------------------------------------- /tests/Test/FlattenTests.elm: -------------------------------------------------------------------------------- 1 | module Test.FlattenTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "Flatten" 20 | [ test "Flatten multiChildTree" 21 | <| assertEqual [ "a", "b", "c", "d" ] 22 | (MultiwayTree.flatten multiChildTree) 23 | , test "Flatten deepTree" 24 | <| assertEqual [ "a", "b", "c", "d" ] 25 | (MultiwayTree.flatten deepTree) 26 | , test "Flatten interestingTree" 27 | <| assertEqual [ "a", "b", "e", "k", "c", "f", "g", "d", "h", "i", "j" ] 28 | (MultiwayTree.flatten interestingTree) 29 | ] 30 | -------------------------------------------------------------------------------- /tests/Test/FoldTests.elm: -------------------------------------------------------------------------------- 1 | module Test.FoldTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "Fold" 20 | [ test "Foldl interestingTree into List" 21 | <| assertEqual (MultiwayTree.flatten interestingTree) 22 | ((MultiwayTree.foldl (::) [] interestingTree) |> List.reverse) 23 | ] 24 | -------------------------------------------------------------------------------- /tests/Test/IndexedMapTests.elm: -------------------------------------------------------------------------------- 1 | module Test.IndexedMapTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "IndexedMap" 20 | [ test "Maps a function with index over the Tree, transforms Tree" <| 21 | assertEqual (List.range 0 10) 22 | (case MultiwayTree.indexedMap (\index c -> index) interestingTree of 23 | Just tree -> 24 | (MultiwayTree.flatten tree) 25 | 26 | Nothing -> 27 | [] 28 | ) 29 | ] 30 | -------------------------------------------------------------------------------- /tests/Test/InsertTests.elm: -------------------------------------------------------------------------------- 1 | module Test.InsertTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | import Test.Utils exposing (..) 16 | 17 | 18 | tests : Test 19 | tests = 20 | suite "Insert" 21 | [ test "Inserting children can turn a multiChildTree into an interestingTree" <| 22 | assertEqual (Just ( interestingTree, [] )) 23 | (Just ( multiChildTree, [] ) 24 | &> goToChild 0 25 | &> insertChild (Tree "e" []) 26 | &> goToChild 0 27 | &> insertChild (Tree "k" []) 28 | &> goUp 29 | &> goRight 30 | &> insertChild (Tree "g" []) 31 | &> insertChild (Tree "f" []) 32 | &> goRight 33 | &> insertChild (Tree "j" []) 34 | &> insertChild (Tree "i" []) 35 | &> insertChild (Tree "h" []) 36 | &> goToRoot 37 | ) 38 | ] 39 | -------------------------------------------------------------------------------- /tests/Test/LengthTests.elm: -------------------------------------------------------------------------------- 1 | module Test.LengthTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "Length" 20 | [ test "Length of an interesting Tree" <| 21 | assertEqual 11 22 | (MultiwayTree.length interestingTree) 23 | , test "Length of a noChildTree" <| 24 | assertEqual 1 25 | (MultiwayTree.length noChildTree) 26 | , test "Length of a deepTree" <| 27 | assertEqual 4 28 | (MultiwayTree.length deepTree) 29 | , test "Length of a Tree is equal to length of a flattened tree" <| 30 | assertEqual (List.length (MultiwayTree.flatten interestingTree)) 31 | (MultiwayTree.length interestingTree) 32 | ] 33 | -------------------------------------------------------------------------------- /tests/Test/MultiwayTreeZipper.elm: -------------------------------------------------------------------------------- 1 | module Test.MultiwayTreeZipper exposing (tests) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import Test.NavigationTests 5 | import Test.UpdateTests 6 | import Test.FlattenTests 7 | import Test.FoldTests 8 | import Test.FilterTests 9 | import Test.FilterWithChildPrecedenceTests 10 | import Test.AppendTests 11 | import Test.InsertTests 12 | import Test.LengthTests 13 | import Test.IndexedMapTests 14 | import Test.TuplesOfDatumAndFlatChildrenTests 15 | import Test.SortTests 16 | 17 | 18 | tests : Test 19 | tests = 20 | suite "MultiwayTreeZipper" 21 | [ Test.NavigationTests.tests 22 | , Test.UpdateTests.tests 23 | , Test.FlattenTests.tests 24 | , Test.FoldTests.tests 25 | , Test.FilterTests.tests 26 | , Test.FilterWithChildPrecedenceTests.tests 27 | , Test.AppendTests.tests 28 | , Test.InsertTests.tests 29 | , Test.LengthTests.tests 30 | , Test.IndexedMapTests.tests 31 | , Test.TuplesOfDatumAndFlatChildrenTests.tests 32 | , Test.SortTests.tests 33 | ] 34 | -------------------------------------------------------------------------------- /tests/Test/NavigationTests.elm: -------------------------------------------------------------------------------- 1 | module Test.NavigationTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData exposing (singleChildTree, multiChildTree, deepTree, noChildTree, interestingTree) 7 | import Test.Utils exposing (..) 8 | 9 | 10 | tests : Test 11 | tests = 12 | suite "Navigation" 13 | [ test "Navigate to child (only child)" <| 14 | assertEqual (Just ( (Tree "b" []), [ Context "a" [] [] ] )) 15 | (Just ( singleChildTree, [] ) 16 | &> goToChild 0 17 | ) 18 | , test "Navigate to child (one of many)" <| 19 | assertEqual 20 | (Just 21 | ( (Tree "c" []) 22 | , [ Context "a" 23 | [ (Tree "b" []) ] 24 | [ (Tree "d" []) ] 25 | ] 26 | ) 27 | ) 28 | (Just ( multiChildTree, [] ) 29 | &> goToChild 1 30 | ) 31 | , test "Navigate to a child (deep)" <| 32 | assertEqual 33 | (Just 34 | ( (Tree "d" []) 35 | , [ Context "c" [] [] 36 | , Context "b" [] [] 37 | , Context "a" [] [] 38 | ] 39 | ) 40 | ) 41 | (Just ( deepTree, [] ) 42 | &> goToChild 0 43 | &> goToChild 0 44 | &> goToChild 0 45 | ) 46 | , test "Navigate to last child of an empty tree returns Nothing" <| 47 | assertEqual Nothing 48 | (Just ( noChildTree, [] ) 49 | &> goToRightMostChild 50 | ) 51 | , test "Navigate to last child of a tree with just one child moves to that child" <| 52 | assertEqual 53 | (Just ( singleChildTree, [] ) 54 | &> goToChild 0 55 | ) 56 | (Just ( singleChildTree, [] ) 57 | &> goToRightMostChild 58 | ) 59 | , test "Navigate to last child of a tree with multiple children moves to the last child" <| 60 | assertEqual 61 | (Just ( multiChildTree, [] ) 62 | &> goToChild 2 63 | ) 64 | (Just ( multiChildTree, [] ) 65 | &> goToRightMostChild 66 | ) 67 | , test "Navigate to last child of an interestingTree" <| 68 | assertEqual 69 | (Just ( interestingTree, [] ) 70 | &> goToChild 2 71 | &> goToChild 2 72 | ) 73 | (Just ( interestingTree, [] ) 74 | &> goToRightMostChild 75 | &> goToRightMostChild 76 | ) 77 | , test "Navigate up (single level)" <| 78 | assertEqual (Just ( (Tree "a" [ Tree "b" [] ]), [] )) 79 | (Just ( singleChildTree, [] ) 80 | &> goToChild 0 81 | &> goUp 82 | ) 83 | , test "Navigate up (single level with many children)" <| 84 | assertEqual (Just ( (Tree "a" [ Tree "b" [], Tree "c" [], Tree "d" [] ]), [] )) 85 | (Just ( multiChildTree, [] ) 86 | &> goToChild 1 87 | &> goUp 88 | ) 89 | , test "Navigate up from a child (deep)" <| 90 | assertEqual (Just ( (Tree "a" [ Tree "b" [ Tree "c" [ Tree "d" [] ] ] ]), [] )) 91 | (Just ( deepTree, [] ) 92 | &> goToChild 0 93 | &> goToChild 0 94 | &> goToChild 0 95 | &> goUp 96 | &> goUp 97 | &> goUp 98 | ) 99 | , test "Navigate beyond the tree (only child)" <| 100 | assertEqual Nothing 101 | (Just ( singleChildTree, [] ) 102 | &> goToChild 0 103 | &> goToChild 0 104 | ) 105 | , test "Navigate beyond the tree (up past root)" <| 106 | assertEqual Nothing 107 | (Just ( singleChildTree, [] ) 108 | &> goUp 109 | ) 110 | , test "Navigate to left sibling on no child tree does not work" <| 111 | assertEqual Nothing 112 | (Just ( noChildTree, [] ) 113 | &> goLeft 114 | ) 115 | , test "Navigate to left child" <| 116 | assertEqual 117 | (Just ( multiChildTree, [] ) 118 | &> goToChild 0 119 | &> goRight 120 | ) 121 | (Just ( multiChildTree, [] ) 122 | &> goToChild 2 123 | &> goLeft 124 | ) 125 | , test "Navigate to left child twice" <| 126 | assertEqual 127 | (Just ( multiChildTree, [] ) 128 | &> goToChild 0 129 | ) 130 | (Just ( multiChildTree, [] ) 131 | &> goToChild 2 132 | &> goLeft 133 | &> goLeft 134 | ) 135 | , test "Navigate to left child when there are no siblings left return Nothing" <| 136 | assertEqual Nothing 137 | (Just ( multiChildTree, [] ) 138 | &> goToChild 0 139 | &> goLeft 140 | ) 141 | , test "Navigate to right sibling on no child tree does not work" <| 142 | assertEqual Nothing 143 | (Just ( noChildTree, [] ) 144 | &> goRight 145 | ) 146 | , test "Navigate to right child" <| 147 | assertEqual 148 | (Just 149 | ( (Tree "c" []) 150 | , [ Context "a" 151 | [ (Tree "b" []) ] 152 | [ (Tree "d" []) ] 153 | ] 154 | ) 155 | ) 156 | (Just ( multiChildTree, [] ) 157 | &> goToChild 0 158 | &> goRight 159 | ) 160 | , test "Navigate to right child twice" <| 161 | assertEqual 162 | (Just ( multiChildTree, [] ) 163 | &> goToChild 2 164 | ) 165 | (Just ( multiChildTree, [] ) 166 | &> goToChild 0 167 | &> goRight 168 | &> goRight 169 | ) 170 | , test "Navigate to right child when there are no siblings left return Nothing" <| 171 | assertEqual Nothing 172 | (Just ( multiChildTree, [] ) 173 | &> goToChild 2 174 | &> goRight 175 | ) 176 | , test "Navigate to next child on Tree with just one node" <| 177 | assertEqual Nothing 178 | (Just ( noChildTree, [] ) 179 | &> goToNext 180 | ) 181 | , test "Navigate to next child on an interesting tree will select the next node" <| 182 | assertEqual 183 | (Just ( interestingTree, [] ) 184 | &> goToChild 0 185 | &> goToChild 0 186 | ) 187 | (Just ( interestingTree, [] ) 188 | &> goToChild 0 189 | &> goToNext 190 | ) 191 | , test "Navigate to next child when the end of a branch has been reached will perform backtracking until the next node down can be reached" <| 192 | assertEqual 193 | (Just ( interestingTree, [] ) 194 | &> goToChild 1 195 | ) 196 | (Just ( interestingTree, [] ) 197 | &> goToChild 0 198 | &> goToChild 0 199 | &> goToChild 0 200 | &> goToNext 201 | ) 202 | , test "Navigating past the end of a Tree will return Nothing" <| 203 | assertEqual Nothing 204 | (Just ( deepTree, [] ) 205 | &> goToNext 206 | &> goToNext 207 | &> goToNext 208 | &> goToNext 209 | ) 210 | , test "Consecutive goToNext on an interestingTree end up on the right Node" <| 211 | assertEqual 212 | (Just ( interestingTree, [] ) 213 | &> goToChild 2 214 | &> goToChild 1 215 | ) 216 | (Just ( interestingTree, [] ) 217 | &> goToNext 218 | &> goToNext 219 | &> goToNext 220 | &> goToNext 221 | &> goToNext 222 | &> goToNext 223 | &> goToNext 224 | &> goToNext 225 | &> goToNext 226 | ) 227 | , test "Navigate to previous child when there are siblings will select the sibling" <| 228 | assertEqual 229 | (Just ( multiChildTree, [] ) 230 | &> goToChild 1 231 | ) 232 | (Just ( multiChildTree, [] ) 233 | &> goToChild 2 234 | &> goToPrevious 235 | ) 236 | , test "Navigate to previous child on an interesting tree will select the previous node" <| 237 | assertEqual 238 | (Just ( interestingTree, [] ) 239 | &> goToChild 0 240 | ) 241 | (Just ( interestingTree, [] ) 242 | &> goToChild 0 243 | &> goToChild 0 244 | &> goToPrevious 245 | ) 246 | , test "Navigate to previous child when the beginning of a branch has been reached will perform backtracking until the next node down can be reached" <| 247 | assertEqual 248 | (Just ( interestingTree, [] ) 249 | &> goToChild 0 250 | &> goToChild 0 251 | &> goToChild 0 252 | ) 253 | (Just ( interestingTree, [] ) 254 | &> goToChild 1 255 | &> goToPrevious 256 | ) 257 | , test "Navigating past the beginning of a Tree will return Nothing" <| 258 | assertEqual Nothing 259 | (Just ( singleChildTree, [] ) 260 | &> goToChild 0 261 | &> goToPrevious 262 | &> goToPrevious 263 | ) 264 | , test "Consecutive goToPrevious on an interestingTree end up on the right Node" <| 265 | assertEqual 266 | (Just ( interestingTree, [] ) 267 | &> goToChild 0 268 | ) 269 | (Just ( interestingTree, [] ) 270 | &> goToChild 2 271 | &> goToChild 2 272 | &> goToPrevious 273 | &> goToPrevious 274 | &> goToPrevious 275 | &> goToPrevious 276 | &> goToPrevious 277 | &> goToPrevious 278 | &> goToPrevious 279 | &> goToPrevious 280 | &> goToPrevious 281 | ) 282 | , test "Trying to find a non existing element in a Tree returns Nothing" <| 283 | assertEqual Nothing 284 | (Just ( interestingTree, [] ) 285 | &> goTo (\elem -> elem == "FOO") 286 | ) 287 | , test "Trying to find an existing element in a Tree moves the focus to this element" <| 288 | assertEqual 289 | (Just ( interestingTree, [] ) 290 | &> goToChild 2 291 | &> goToChild 0 292 | ) 293 | (Just ( interestingTree, [] ) 294 | &> goTo (\elem -> elem == "h") 295 | ) 296 | ] 297 | -------------------------------------------------------------------------------- /tests/Test/SampleData.elm: -------------------------------------------------------------------------------- 1 | module Test.SampleData exposing (..) 2 | 3 | import MultiwayTree exposing (Tree(..), Forest) 4 | 5 | 6 | interestingTree : Tree String 7 | interestingTree = 8 | Tree "a" 9 | [ Tree "b" 10 | [ Tree "e" 11 | [ Tree "k" [] ] 12 | ] 13 | , Tree "c" 14 | [ Tree "f" [] 15 | , Tree "g" [] 16 | ] 17 | , Tree "d" 18 | [ Tree "h" [] 19 | , Tree "i" [] 20 | , Tree "j" [] 21 | ] 22 | ] 23 | 24 | 25 | noChildTree = 26 | Tree "a" [] 27 | 28 | 29 | noChildRecord = 30 | Tree { selected = False, expanded = False } [] 31 | 32 | 33 | singleChildTree = 34 | Tree "a" 35 | [ Tree "b" [] ] 36 | 37 | 38 | multiChildTree = 39 | Tree "a" 40 | [ Tree "b" [] 41 | , Tree "c" [] 42 | , Tree "d" [] 43 | ] 44 | 45 | 46 | deepTree = 47 | Tree "a" 48 | [ Tree "b" 49 | [ Tree "c" 50 | [ Tree "d" [] ] 51 | ] 52 | ] 53 | 54 | 55 | simpleForest = 56 | [ (Tree "x" []) 57 | , (Tree "y" []) 58 | , (Tree "z" []) 59 | ] 60 | -------------------------------------------------------------------------------- /tests/Test/SortTests.elm: -------------------------------------------------------------------------------- 1 | module Test.SortTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import Test.SampleData 6 | exposing 7 | ( noChildTree 8 | , singleChildTree 9 | , multiChildTree 10 | , deepTree 11 | , noChildRecord 12 | , interestingTree 13 | ) 14 | 15 | 16 | unorderedTree : Tree String 17 | unorderedTree = 18 | Tree "a" 19 | [ Tree "c" 20 | [ Tree "g" [] 21 | , Tree "f" [] 22 | ] 23 | , Tree "b" 24 | [ Tree "e" 25 | [ Tree "k" [] ] 26 | ] 27 | , Tree "d" 28 | [ Tree "i" [] 29 | , Tree "h" [] 30 | , Tree "j" [] 31 | ] 32 | ] 33 | 34 | 35 | reverseSortedTree : Tree String 36 | reverseSortedTree = 37 | Tree "a" 38 | [ Tree "d" 39 | [ Tree "j" [] 40 | , Tree "i" [] 41 | , Tree "h" [] 42 | ] 43 | , Tree "c" 44 | [ Tree "g" [] 45 | , Tree "f" [] 46 | ] 47 | , Tree "b" 48 | [ Tree "e" 49 | [ Tree "k" [] ] 50 | ] 51 | ] 52 | 53 | 54 | flippedComparison : comparable -> comparable -> Order 55 | flippedComparison a b = 56 | case compare a b of 57 | LT -> 58 | GT 59 | 60 | EQ -> 61 | EQ 62 | 63 | GT -> 64 | LT 65 | 66 | 67 | tests : Test 68 | tests = 69 | suite "Sort" 70 | [ test "Sorting a Tree with only one child per levels yields the same Tree" <| 71 | assertEqual deepTree 72 | (MultiwayTree.sortBy identity deepTree) 73 | , test "Sorting a sorted Tree returns the same Tree" <| 74 | assertEqual interestingTree 75 | (MultiwayTree.sortBy identity interestingTree) 76 | , test "Sorting an unsorted Tree returns a sorted Tree" <| 77 | assertEqual interestingTree 78 | (MultiwayTree.sortBy identity unorderedTree) 79 | , test "Sorting with a Tree with a reversed comperator reverse-sorts a Tree" <| 80 | assertEqual reverseSortedTree 81 | (MultiwayTree.sortWith flippedComparison interestingTree) 82 | ] 83 | -------------------------------------------------------------------------------- /tests/Test/TuplesOfDatumAndFlatChildrenTests.elm: -------------------------------------------------------------------------------- 1 | module Test.TuplesOfDatumAndFlatChildrenTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , noChildRecord 13 | , interestingTree 14 | ) 15 | 16 | 17 | tests : Test 18 | tests = 19 | suite "TuplesOfDatumAndFlatChildren" 20 | [ test "TuplesOfDatumAndFlatChildren multiChildTree" <| 21 | assertEqual [ ( "a", [ "b", "c", "d" ] ), ( "b", [] ), ( "c", [] ), ( "d", [] ) ] 22 | (MultiwayTree.tuplesOfDatumAndFlatChildren multiChildTree) 23 | , test "TuplesOfDatumAndFlatChildren deepTree" <| 24 | assertEqual [ ( "a", [ "b", "c", "d" ] ), ( "b", [ "c", "d" ] ), ( "c", [ "d" ] ), ( "d", [] ) ] 25 | (MultiwayTree.tuplesOfDatumAndFlatChildren deepTree) 26 | , test "TuplesOfDatumAndFlatChildren interestingTree" <| 27 | assertEqual 28 | [ ( "a", [ "b", "e", "k", "c", "f", "g", "d", "h", "i", "j" ] ) 29 | , ( "b", [ "e", "k" ] ) 30 | , ( "e", [ "k" ] ) 31 | , ( "k", [] ) 32 | , ( "c", [ "f", "g" ] ) 33 | , ( "f", [] ) 34 | , ( "g", [] ) 35 | , ( "d", [ "h", "i", "j" ] ) 36 | , ( "h", [] ) 37 | , ( "i", [] ) 38 | , ( "j", [] ) 39 | ] 40 | (MultiwayTree.tuplesOfDatumAndFlatChildren interestingTree) 41 | ] 42 | -------------------------------------------------------------------------------- /tests/Test/UpdateTests.elm: -------------------------------------------------------------------------------- 1 | module Test.UpdateTests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import MultiwayTree exposing (Tree(..)) 5 | import MultiwayTreeZipper exposing (..) 6 | import Test.SampleData 7 | exposing 8 | ( noChildTree 9 | , singleChildTree 10 | , multiChildTree 11 | , deepTree 12 | , interestingTree 13 | , simpleForest 14 | , noChildRecord 15 | ) 16 | import Test.Utils exposing (..) 17 | 18 | 19 | tests : Test 20 | tests = 21 | suite "Update" 22 | [ test "Update datum (simple)" <| 23 | assertEqual 24 | (Just ( (Tree "ax" []), [] )) 25 | (Just ( noChildTree, [] ) 26 | &> updateDatum (\a -> a ++ "x") 27 | ) 28 | , test "Update datum (record)" <| 29 | assertEqual 30 | (Just ( (Tree { selected = True, expanded = False } []), [] )) 31 | (Just ( noChildRecord, [] ) 32 | &> updateDatum (\rec -> { rec | selected = True }) 33 | ) 34 | , test "Replace datum (simple)" <| 35 | assertEqual 36 | (Just ( (Tree "x" []), [] )) 37 | (Just ( noChildTree, [] ) 38 | &> replaceDatum "x" 39 | ) 40 | , test "Replace datum (record)" <| 41 | assertEqual 42 | (Just ( (Tree { selected = True, expanded = True } []), [] )) 43 | (Just ( noChildRecord, [] ) 44 | &> replaceDatum { selected = True, expanded = True } 45 | ) 46 | , test "Replace children (replace with empty)" <| 47 | assertEqual 48 | (Just ( noChildTree, [] )) 49 | (Just ( singleChildTree, [] ) 50 | &> updateChildren [] 51 | ) 52 | , test "Replace children (replace with specific)" <| 53 | assertEqual 54 | (Just ( Tree "a" simpleForest, [] )) 55 | (Just ( interestingTree, [] ) 56 | &> updateChildren simpleForest 57 | ) 58 | ] 59 | -------------------------------------------------------------------------------- /tests/Test/Utils.elm: -------------------------------------------------------------------------------- 1 | module Test.Utils exposing (..) 2 | 3 | (&>) = flip Maybe.andThen 4 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (..) 2 | 3 | import Legacy.ElmTest as ElmTest exposing (..) 4 | import Test.MultiwayTreeZipper as MultiwayTreeZipper 5 | 6 | 7 | all : Test 8 | all = 9 | suite "Elm MultiwayTreeZipper Tests" 10 | [ MultiwayTreeZipper.tests 11 | ] 12 | 13 | 14 | main : Program Never () msg 15 | main = 16 | runSuite all 17 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Tests for elm-multiway-tree-zipper", 4 | "repository": "https://github.com/tomjkidd/elm-multiway-tree-zipper.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 13 | "rtfeldman/legacy-elm-test": "3.0.0 <= v < 4.0.0" 14 | }, 15 | "elm-version": "0.18.0 <= v < 0.19.0" 16 | } 17 | --------------------------------------------------------------------------------