├── .nvmrc ├── tests ├── .gitignore ├── Tests.elm ├── Main.elm ├── elm-package.json └── Tests │ ├── Node.elm │ └── Tree.elm ├── .gitignore ├── src └── Chae │ ├── Id.elm │ ├── Node.elm │ └── Tree.elm ├── examples ├── elm-package.json ├── DummyExample.elm ├── BrowserExample.elm └── MenuExample.elm ├── elm-package.json ├── .travis.yml ├── package.json ├── LICENSE └── README.md /.nvmrc: -------------------------------------------------------------------------------- 1 | 4.2 2 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff/ 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | node_modules/ 3 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Tests.Tree 5 | import Tests.Node 6 | 7 | 8 | all : Test 9 | all = 10 | describe "All" 11 | [ Tests.Tree.all 12 | , Tests.Node.all ] 13 | -------------------------------------------------------------------------------- /tests/Main.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (..) 2 | 3 | import Tests 4 | import Test.Runner.Node exposing (run) 5 | import Json.Encode exposing (Value) 6 | 7 | 8 | main : Test.Runner.Node.TestProgram 9 | main = 10 | run emit Tests.all 11 | 12 | 13 | port emit : ( String, Value ) -> Cmd msg 14 | -------------------------------------------------------------------------------- /src/Chae/Id.elm: -------------------------------------------------------------------------------- 1 | module Chae.Id exposing (Id, toId) 2 | 3 | {-| This module contains `Id` type implementation. 4 | 5 | # Definition 6 | @docs Id 7 | 8 | # Constructor 9 | @docs toId 10 | 11 | -} 12 | 13 | 14 | {-| -} 15 | type alias Id = 16 | String 17 | 18 | 19 | {-| Convert any value to `Id` type. 20 | This is just alias for `toString` function. 21 | 22 | toId "str" = "\"str\"" 23 | toId 1 = "1" 24 | toId { a = "a" } = "{ a = \"a\" }" 25 | -} 26 | toId : a -> Id 27 | toId = 28 | toString 29 | -------------------------------------------------------------------------------- /examples/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "helpful summary of your project, less than 80 characters", 4 | "repository": "https://github.com/user/project.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 | "elm-lang/html": "2.0.0 <= v < 3.0.0" 14 | }, 15 | "elm-version": "0.18.0 <= v < 0.19.0" 16 | } 17 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.1.1", 3 | "summary": "Create multi-level navigation in elm easily.", 4 | "repository": "https://github.com/turboMaCk/chae-tree.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [ 10 | "Chae.Id", 11 | "Chae.Node", 12 | "Chae.Tree" 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 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Sample Elm Test", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-community/elm-test": "3.1.0 <= v < 4.0.0", 13 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 14 | "rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0" 15 | }, 16 | "elm-version": "0.18.0 <= v < 0.19.0" 17 | } 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | os: 4 | - linux 5 | 6 | env: 7 | matrix: 8 | - ELM_VERSION=0.18.0 TARGET_NODE_VERSION=node 9 | 10 | before_install: 11 | - if [ ${TRAVIS_OS_NAME} == "osx" ]; 12 | then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh; 13 | fi 14 | - echo -e "Host github.com\n\tStrictHostKeyChecking no\n" >> ~/.ssh/config 15 | 16 | install: 17 | - nvm install $TARGET_NODE_VERSION 18 | - nvm use $TARGET_NODE_VERSION 19 | - node --version 20 | - npm --version 21 | - npm install -g elm@$ELM_VERSION 22 | - npm install 23 | - pushd tests && elm-package install -y && popd 24 | 25 | script: 26 | - npm test 27 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "chae-tree", 3 | "version": "2.0.0", 4 | "description": "Create multi level navigation in elm easily.", 5 | "main": "index.js", 6 | "directories": { 7 | "example": "examples", 8 | "test": "tests" 9 | }, 10 | "dependencies": {}, 11 | "devDependencies": { 12 | "elm-test": "0.18.0" 13 | }, 14 | "scripts": { 15 | "test": "./node_modules/.bin/elm-test" 16 | }, 17 | "repository": { 18 | "type": "git", 19 | "url": "git+https://github.com/turboMaCk/chae-tree.git" 20 | }, 21 | "keywords": [ 22 | "Elm", 23 | "Tree", 24 | "Rose", 25 | "Tree", 26 | "Chae", 27 | "Navigation" 28 | ], 29 | "author": "Marek Fajkus", 30 | "license": "BSD-3-Clause", 31 | "bugs": { 32 | "url": "https://github.com/turboMaCk/chae-tree/issues" 33 | }, 34 | "homepage": "https://github.com/turboMaCk/chae-tree#readme" 35 | } 36 | -------------------------------------------------------------------------------- /examples/DummyExample.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import List exposing (..) 4 | import Html exposing (..) 5 | import Maybe 6 | import Chae.Id as Id 7 | import Chae.Tree as Tree 8 | 9 | 10 | tree1 : Tree.Tree number 11 | tree1 = 12 | Tree.push Id.toId Nothing 1 [] 13 | |> Tree.push Id.toId (Just "1") 2 14 | |> Tree.push Id.toId (Just "2") 3 15 | 16 | 17 | list : List { id : number, pid : List number1 } 18 | list = 19 | [ { id = 1, pid = [] }, { id = 2, pid = [] }, { id = 3, pid = [ 1 ] } ] 20 | 21 | 22 | tree2 : Tree.Tree { id : number, pid : List number1 } 23 | tree2 = 24 | Tree.fromList (\a -> Id.toId (.id a)) (\a -> .pid a |> List.map Id.toId) list 25 | 26 | 27 | main : Html msg 28 | main = 29 | div [] 30 | [ div [] 31 | [ text (tree1 |> toString) ] 32 | , div [] 33 | [ text (tree2 |> toString) ] 34 | ] 35 | -------------------------------------------------------------------------------- /tests/Tests/Node.elm: -------------------------------------------------------------------------------- 1 | module Tests.Node exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | 6 | 7 | -- Library 8 | 9 | import Chae.Node as Node 10 | 11 | 12 | all : Test 13 | all = 14 | describe "Node" 15 | [ functorTest ] 16 | 17 | 18 | 19 | -- Tests 20 | 21 | 22 | functorTest : Test 23 | functorTest = 24 | let 25 | node : Node.Node Int 26 | node = 27 | Node.node "1" 1 [ Node.singleton "2" 2 ] 28 | in 29 | describe "Act like functor" 30 | [ test "1st law" <| 31 | \() -> 32 | Expect.equal 33 | (Node.map identity node) 34 | (identity node) 35 | , test "2nd law" <| 36 | \() -> 37 | let 38 | fc1 = 39 | toString 40 | 41 | fc2 str = 42 | "Hi " ++ str 43 | in 44 | Expect.equal 45 | (Node.map (fc2 << fc1) node) 46 | (Node.map fc1 node |> Node.map fc2) 47 | ] 48 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Marek Fajkus 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of ChaeTree nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /examples/BrowserExample.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import List exposing (..) 4 | import Html exposing (..) 5 | import Html.Events as Events 6 | 7 | 8 | -- Lib import 9 | 10 | import Chae.Id as Id exposing (Id) 11 | import Chae.Node as Node exposing (Node) 12 | import Chae.Tree as Tree exposing (Tree) 13 | 14 | 15 | -- Model 16 | 17 | 18 | type alias Item = 19 | { id : String, name : String, parentIds : List String } 20 | 21 | 22 | items : List Item 23 | items = 24 | [ { id = "a", name = "root", parentIds = [] } 25 | , { id = "b", name = "next root", parentIds = [] } 26 | , { id = "c", name = "nested", parentIds = [ "b" ] } 27 | , { id = "d", name = "deep nested", parentIds = [ "c" ] } 28 | ] 29 | 30 | 31 | type alias Model = 32 | { items : Tree Item, opened : List Id } 33 | 34 | 35 | initialModel : Model 36 | initialModel = 37 | { items = Tree.fromList (.id) (.parentIds) items 38 | , opened = List.map .id items 39 | } 40 | 41 | 42 | init : ( Model, Cmd Msg ) 43 | init = 44 | initialModel ! [] 45 | 46 | 47 | 48 | -- Update 49 | 50 | 51 | type Msg 52 | = NoOp 53 | | Toggle Id 54 | 55 | 56 | update : Msg -> Model -> ( Model, Cmd Msg ) 57 | update cmd model = 58 | case cmd of 59 | NoOp -> 60 | model ! [] 61 | 62 | Toggle id -> 63 | case partition (\o -> o == id) model.opened of 64 | ( [], rest ) -> 65 | { model | opened = id :: rest } ! [] 66 | 67 | ( _, rest ) -> 68 | { model | opened = rest } ! [] 69 | 70 | 71 | 72 | -- View 73 | 74 | 75 | isOpened : List Id -> Node a -> Bool 76 | isOpened list node = 77 | member (Node.id node) list 78 | 79 | 80 | itemView : Model -> Node Item -> Html Msg 81 | itemView model node = 82 | let 83 | item = 84 | Node.root node 85 | 86 | open = 87 | isOpened (.opened model) node 88 | 89 | symbol = 90 | if length (Node.children node) > 0 then 91 | if open then 92 | "[-] " 93 | else 94 | "[+] " 95 | else 96 | "[ ] " 97 | in 98 | li [] 99 | [ a [ Events.onClick (Toggle (Node.id node)) ] 100 | [ text (symbol ++ item.name) ] 101 | , if open then 102 | listView model (Node.children node) 103 | else 104 | text "" 105 | ] 106 | 107 | 108 | listView : Model -> Tree Item -> Html Msg 109 | listView model items = 110 | ul [] 111 | (List.map (\n -> itemView model n) items) 112 | 113 | 114 | view : Model -> Html Msg 115 | view model = 116 | listView model (.items model) 117 | 118 | 119 | main : Program Never Model Msg 120 | main = 121 | Html.program 122 | { init = init 123 | , update = update 124 | , view = view 125 | , subscriptions = \_ -> Sub.none 126 | } 127 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Chae-Tree 2 | 3 | [![Build Status](https://travis-ci.org/turboMaCk/chae-tree.svg?branch=master)](https://travis-ci.org/turboMaCk/chae-tree) 4 | 5 | **This package is now deprecated and won't be upgraded for next version of elm! 6 | Please pick one of following instead:** 7 | 8 | - [turboMaCk/lazy-tree-with-zipper](https://github.com/turboMaCk/lazy-tree-with-zipper) lazy rose-tree with zipper 9 | - [tomjkidd/elm-multiway-tree-zipper](https://github.com/tomjkidd/elm-multiway-tree-zipper/) strict rose-tree with zipper 10 | 11 | Create multi-level navigation in elm easily. 12 | 13 | This package provides essential abstractions for manipulating and creating tree data structure directly from your collection data. 14 | 15 | Imagine you have collection of some items which has defined parent <-> children relationship. 16 | This package provides easy and universal way to transform this list to tree like data structure 17 | and comes with easy to use functions you can use to work with it. 18 | For example you can easily browse this tree by levels, getting ancestors of node etc. 19 | 20 | This package makes no decision about neither `update` nor `model` nor `view`. 21 | You can build your own application level logic as you wish and just use provided api to manipulate your data. 22 | Every abstraction which you might need is build in so you're saved from thinking about implementation details 23 | and rather focus on actual UI and business logic. 24 | 25 | The name comes from [Chaenomeles](https://en.wikipedia.org/wiki/Chaenomeles) and is reference to similarities with [RoseTree](https://en.wikipedia.org/wiki/Rose_tree) 26 | 27 | **The good place to start is by looking on [example code](https://github.com/turboMaCk/ChaeTree/tree/master/examples).** 28 | 29 | # Installation 30 | 31 | ``` 32 | elm-package install turboMaCk/chae-tree 33 | ``` 34 | 35 | For more informations please follow [documentation](http://package.elm-lang.org/packages/turboMaCk/chae-tree/latest) 36 | or see [examples](https://github.com/turboMaCk/ChaeTree/tree/master/examples) of usage. 37 | 38 | # More About Data Structure 39 | 40 | You might be familiar with [Rose Tree](https://en.wikipedia.org/wiki/Rose_tree) data structure. 41 | The data structure this plugin uses is quite similar but not really the same. 42 | This paragraph(s) is to explain similarities and differences between the two and more importantly explain why they are there. 43 | First things first **please do not use this implementation as an alternative to plain Rose Trees!** 44 | Even they share some similarities you can find it unnecessary hard to use this in every place you might want to use Rose Tree. 45 | Think about this as about more domain specific *tree like* structure which might be quite handy for one thing but not that good for some other. 46 | 47 | ## Chae.Tree is Forest 48 | 49 | In fact `Tree` in the context of this plugin **is not** node containing item and children. 50 | Tree is collection of multiple nodes (`List` of `Node a` to be more precise). 51 | Thanks to this `Chae.Tree` allows you to have multiple nodes in root. 52 | For example think about collection of categories where every category can have multiple sub-categories. 53 | In that case `Tree` is actual collection and every category is one `Node` in that tree. 54 | 55 | ## Chae.Node is not Rose Tree Either 56 | 57 | Now you might be thinking that if `Tree` is just an alias for `List (Node a)` than `Node a` is actually a Rose Tree. 58 | You're partially right! In fact `Node` is pretty close to Rose Tree definition which might look like: 59 | 60 | ```elm 61 | type RoseTree a = Node a (List (RoseTree a)) 62 | ``` 63 | 64 | in fact node is defined as follows: 65 | 66 | ```elm 67 | type Node a = Node Id a (List (Node a)) 68 | 69 | ``` 70 | 71 | So what is that magic `Id`? `Id` is just alias for `String`. And this Id/String is used as identifier for that node. 72 | The string is used since you can easily represent any value using string 73 | and since it do not makes much sense to allow any arithmetics over identifier it's perfect fit for ids. 74 | 75 | So every node in `Tree` has its id. What is this good for? Well first of all you can lookup any node by knowing its id. 76 | Also it is super easy to build tree from plain `List` if you just know what is a parent of each item in that list. 77 | 78 | **All these functions are implemented for you so you can simple transform your flat collection into tree and start quering it by ids.** 79 | 80 | ## Functors 81 | 82 | Beside this both `Node` and `Tree` are functors and you can find essential functions like `map`, `reduce`, `zip` and similar 83 | in particular module. 84 | -------------------------------------------------------------------------------- /examples/MenuExample.elm: -------------------------------------------------------------------------------- 1 | -- Common imports 2 | 3 | 4 | module Main exposing (..) 5 | 6 | import List exposing (..) 7 | import Html exposing (..) 8 | import Html.Events as Events 9 | import Maybe 10 | 11 | 12 | -- Lib import 13 | 14 | import Chae.Id as Id exposing (Id) 15 | import Chae.Node as Node exposing (Node) 16 | import Chae.Tree as Tree exposing (Tree) 17 | 18 | 19 | type Either a b 20 | = Left a 21 | | Right b 22 | 23 | 24 | 25 | -- Model 26 | 27 | 28 | type alias Question = 29 | { id : Int, name : String, categoryIds : List Int } 30 | 31 | 32 | type alias Category = 33 | { id : Int, name : String, parentId : Maybe Int } 34 | 35 | 36 | categories : List Category 37 | categories = 38 | [ { id = 1, name = "first", parentId = Nothing } 39 | , { id = 2, name = "child", parentId = Just 1 } 40 | , { id = 3, name = "deep child", parentId = Just 2 } 41 | ] 42 | 43 | 44 | questions : List Question 45 | questions = 46 | [ { id = 1, name = "root item", categoryIds = [] } 47 | , { id = 2, name = "item with parent", categoryIds = [ 1 ] } 48 | , { id = 3, name = "deeper nested item", categoryIds = [ 2 ] } 49 | , { id = 4, name = "item with two parents", categoryIds = [ 2, 3 ] } 50 | ] 51 | 52 | 53 | getId : Either Category Question -> Id 54 | getId thing = 55 | case thing of 56 | Left category -> 57 | Id.toId category.id 58 | 59 | Right question -> 60 | Id.toId question.id 61 | 62 | 63 | getParentIds : Either Category Question -> List Id 64 | getParentIds thing = 65 | case thing of 66 | Left category -> 67 | case category.parentId of 68 | Just id -> 69 | [ Id.toId id ] 70 | 71 | Nothing -> 72 | [] 73 | 74 | Right question -> 75 | List.map (\id -> Id.toId id) question.categoryIds 76 | 77 | 78 | list : List (Either Category Question) 79 | list = 80 | (List.map (\c -> Left c) categories) ++ List.map (\q -> Right q) questions 81 | 82 | 83 | tree : Tree (Either Category Question) 84 | tree = 85 | Tree.fromList getId getParentIds list 86 | 87 | 88 | type alias Model = 89 | { activeCategoryId : Maybe String 90 | , tree : Tree (Either Category Question) 91 | } 92 | 93 | 94 | initialModel : Model 95 | initialModel = 96 | { activeCategoryId = Nothing, tree = tree } 97 | 98 | 99 | 100 | -- Upadte 101 | 102 | 103 | type Msg 104 | = NoOp 105 | | Open (Maybe Id) 106 | 107 | 108 | init : ( Model, Cmd Msg ) 109 | init = 110 | initialModel ! [] 111 | 112 | 113 | update : Msg -> Model -> ( Model, Cmd Msg ) 114 | update msg model = 115 | case msg of 116 | NoOp -> 117 | model ! [] 118 | 119 | Open id -> 120 | { model | activeCategoryId = id } ! [] 121 | 122 | 123 | 124 | -- View 125 | 126 | 127 | itemView : Node (Either Category Question) -> Html Msg 128 | itemView node = 129 | case Node.root node of 130 | Right question -> 131 | li [] [ text ("item: " ++ (.name question)) ] 132 | 133 | Left category -> 134 | li [] 135 | [ a [ Events.onClick (Open (Just (Node.id node))) ] 136 | [ text ("category: " ++ category.name ++ " >") ] 137 | ] 138 | 139 | 140 | menuView : Tree (Either Category Question) -> Html Msg 141 | menuView list = 142 | ul [] 143 | (List.map itemView list) 144 | 145 | 146 | ancestorView : Either Category Question -> Html Msg 147 | ancestorView thing = 148 | let 149 | openArg category = 150 | case (.parentId category) of 151 | Just id -> 152 | Just (Id.toId id) 153 | 154 | Nothing -> 155 | Nothing 156 | in 157 | case thing of 158 | Right _ -> 159 | text "" 160 | 161 | Left category -> 162 | li 163 | [] 164 | [ a [ Events.onClick (Open (openArg category)) ] 165 | [ text (.name category ++ " ^") ] 166 | ] 167 | 168 | 169 | ancestorsView : List (Either Category Question) -> Html Msg 170 | ancestorsView things = 171 | ul [] 172 | (List.map (\c -> ancestorView c) (reverse things)) 173 | 174 | 175 | menu : ( Tree (Either Category Question), List (Either Category Question) ) -> Html Msg 176 | menu ( tree, categories ) = 177 | div [] 178 | [ ancestorsView categories 179 | , menuView tree 180 | ] 181 | 182 | 183 | view : Model -> Html Msg 184 | view model = 185 | menu (Tree.subTreeFor model.activeCategoryId model.tree) 186 | 187 | 188 | main : Program Never Model Msg 189 | main = 190 | Html.program 191 | { init = init 192 | , update = update 193 | , view = view 194 | , subscriptions = \_ -> Sub.none 195 | } 196 | -------------------------------------------------------------------------------- /src/Chae/Node.elm: -------------------------------------------------------------------------------- 1 | module Chae.Node 2 | exposing 3 | ( Node(..) 4 | , singleton 5 | , node 6 | , id 7 | , root 8 | , addChild 9 | , children 10 | , hasChildren 11 | , toTuple 12 | , map 13 | , map2 14 | , flatten 15 | , flatMap 16 | , reduce 17 | , pushDeep 18 | ) 19 | 20 | {-| Node is [Rose Tree](https://en.wikipedia.org/wiki/Rose_tree) like data structure beside it also have its id. 21 | This Id is essential to some manipulations Chae-Tree provides. 22 | If you're looking for `Rose Tree` you'll better pick some regular implementation. 23 | Chae Tree is domain specific with focus on building multi level navigation or similar UI elements. 24 | It's not necessary the best pick if you want to process structural data beside you want to use functions 25 | like `pushDeep`. 26 | 27 | # Definition 28 | @docs Node 29 | 30 | # Constructors 31 | @docs singleton, node 32 | 33 | # Query a Node 34 | @docs id, root, children, hasChildren, toTuple 35 | 36 | # Common operations 37 | @docs addChild, pushDeep 38 | 39 | # Map - Reduce 40 | @docs map, map2, flatten, flatMap, reduce 41 | 42 | -} 43 | 44 | import List 45 | import Chae.Id exposing (..) 46 | 47 | 48 | -- Types 49 | 50 | 51 | {-| -} 52 | type Node a 53 | = Node Id a (List (Node a)) 54 | 55 | 56 | 57 | -- Common Helpers 58 | 59 | 60 | {-| Create empty `Node` for given values. 61 | First paramter is function which takes given value and return it's id. 62 | 63 | singleton "1" 1 == Node "1" 1 [] 64 | singleton "1" { a = "b" } == Node "1" { a = "b" } [] 65 | -} 66 | singleton : Id -> a -> Node a 67 | singleton id item = 68 | Node id item [] 69 | 70 | 71 | {-| Create node. Alias for Node constructor (which was opaque in previous releases) 72 | 73 | node "1" 1 [] == Node "1" 1 [] 74 | node "1" 1 [ node "2" 2 [] ] == Node "1" 1 ([Node "2" 2 []]) 75 | -} 76 | node : Id -> b -> List (Node b) -> Node b 77 | node = 78 | Node 79 | 80 | 81 | {-| Get id of given `Node`. 82 | 83 | id (singleton "1" 1) == "1" 84 | id (singleton "uid" { a = "a"} ) == "uid" 85 | -} 86 | id : Node a -> Id 87 | id (Node id _ _) = 88 | id 89 | 90 | 91 | {-| Turns `Node` back to value it was created from. 92 | 93 | This function provide recommended way to access user space data while working with tree. 94 | 95 | root (singleton "1" "Elm") == "Elm" 96 | root (singleton "1" { id = "1", name = "Elm" }) == { id = "1", name = "Elm" } 97 | -} 98 | root : Node a -> a 99 | root (Node _ a _) = 100 | a 101 | 102 | 103 | {-| Return `Node` with item add as sub `Node`. 104 | First argument is function from item to `Id/String`. 105 | 106 | addChild "2" 2 (singleton "1" 1) == Node "1" 1 ([Node "2" 2 []]) 107 | addChild "3" 3 (addChild "2" 2 (singleton "1" 1)) == Node "1" 1 ([Node "3" 3 [],Node "2" 2 []]) 108 | -} 109 | addChild : Id -> a -> Node a -> Node a 110 | addChild id item (Node ida a children) = 111 | Node ida a <| singleton id item :: children 112 | 113 | 114 | {-| Get child tree of `Node`. 115 | This is common way to access sub tree of given node. 116 | 117 | children (singleton "1" 1) == [] 118 | children (addChild "2" 2 (singleton "1" 1)) == [Node "2" 2 []] 119 | -} 120 | children : Node a -> List (Node a) 121 | children (Node _ _ children) = 122 | children 123 | 124 | 125 | {-| Check if tree has children 126 | 127 | hasChildren (singleton "1" 1) == False 128 | hasChildren (addChild "2" 2 (singleton "1" 1)) == True 129 | -} 130 | hasChildren : Node a -> Bool 131 | hasChildren tree = 132 | children tree |> List.isEmpty |> not 133 | 134 | 135 | {-| Transform node to tuple of `( id, item, children )` 136 | 137 | toTuple (singleton "1" 1) == ("1",1,[]) 138 | toTuple (node "1" 1 [(singleton "2" 2)]) == ("1",1,[Node "2" 2 []]) 139 | -} 140 | toTuple : Node a -> ( Id, a, List (Node a) ) 141 | toTuple (Node id a c) = 142 | ( id, a, c ) 143 | 144 | 145 | 146 | -- Common operations 147 | 148 | 149 | {-| Map function on tree 150 | produces new modified tree 151 | 152 | map ((+) 1) (addChild "2" 2 (singleton "1" 1)) == Node "1" 2 ([Node "2" 3 []]) 153 | -} 154 | map : (a -> b) -> Node a -> Node b 155 | map fc (Node id a c) = 156 | Node id (fc a) <| List.map (map fc) c 157 | 158 | 159 | {-| Similar to map, but takes two Nodes and produce new one by combining items of both 160 | -} 161 | map2 : 162 | (a -> b -> c) 163 | -> Node a 164 | -> Node b 165 | -> Node c 166 | map2 fc (Node id a ca) (Node _ b cb) = 167 | Node id (fc a b) <| List.map2 (map2 fc) ca cb 168 | 169 | 170 | {-| Similar to `List.zip` but working with Node 171 | -} 172 | zip : Node a -> Node b -> Node ( a, b ) 173 | zip = 174 | map2 (,) 175 | 176 | 177 | {-| Flatten Node of Nodes to Node. 178 | -} 179 | flatten : Node (Node a) -> Node a 180 | flatten (Node id (Node id2 a c) cs) = 181 | Node id a <| c ++ List.map flatten cs 182 | 183 | 184 | {-| Map and flatten 185 | 186 | n = node "1" 1 [ node "2" 2 [], node "3" 3 [ node "4" 4 []]] 187 | 188 | flatMap (\a -> node "2" (a * 2) []) n == Node "1" 2 ([Node "2" 4 [],Node "3" 6 ([Node "4" 8 []])]) 189 | flatMap (\a -> node "2" (a * 2) [ node "1" (a * 3) [] ] ) m == Node "1" 2 ([Node "1" 3 [],Node "2" 4 ([Node "1" 6 []]),Node "3" 6 ([Node "1" 9 [],Node "4" 8 ([Node "1" 12 []])])]) 190 | -} 191 | flatMap : (a -> Node b) -> Node a -> Node b 192 | flatMap fc = 193 | flatten << map fc 194 | 195 | 196 | {-| Reduce Node by given function. Similar to `List.foldr` 197 | 198 | reduce (+) 0 (addChild "20" 20 (singleton "1" 1)) == 21 199 | reduce (*) 1 (addChild "3" 3 (singleton "4" 4)) == 12 200 | -} 201 | reduce : (a -> b -> b) -> b -> Node a -> b 202 | reduce reducer b (Node _ a c) = 203 | List.foldr (flip <| reduce reducer) (reducer a b) c 204 | 205 | 206 | {-| Find parent node in children by id and push new item to it 207 | 208 | n = node "1" 1 [ node "2" 2 [], node "3" 3 [ node "4" 4 []]] 209 | 210 | pushDeep "4" "10" 10 n == Node "1" 1 ([Node "2" 2 [],Node "3" 3 ([Node "4" 4 ([Node "10" 10 []])])]) 211 | -} 212 | pushDeep : 213 | Id 214 | -> Id 215 | -> a 216 | -> Node a 217 | -> Node a 218 | pushDeep id aid item ((Node nodeId a children) as node) = 219 | if nodeId == id then 220 | addChild aid item node 221 | else 222 | Node nodeId a <| List.map (pushDeep id aid item) children 223 | -------------------------------------------------------------------------------- /tests/Tests/Tree.elm: -------------------------------------------------------------------------------- 1 | module Tests.Tree exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import String 6 | 7 | 8 | -- Library 9 | 10 | import Chae.Tree as Tree exposing (..) 11 | import Chae.Node as Node exposing (node) 12 | 13 | 14 | -- Exposed 15 | 16 | 17 | all : Test 18 | all = 19 | describe "Tree" 20 | [ functorTest 21 | , filterTest 22 | , deepFilterTest 23 | , pushTest 24 | , fromListTest 25 | , subTreeForTests 26 | ] 27 | 28 | 29 | 30 | -- Fixtures 31 | 32 | 33 | items = 34 | [ { id = 1, name = "first", parentIds = [] } 35 | , { id = 2, name = "child", parentIds = [ 1 ] } 36 | , { id = 3, name = "deep child", parentIds = [ 2 ] } 37 | ] 38 | 39 | 40 | toId id = 41 | toString id 42 | 43 | 44 | itemId item = 45 | toId (.id item) 46 | 47 | 48 | itemParentIds item = 49 | .parentIds item |> List.map toId 50 | 51 | 52 | tree = 53 | fromList itemId itemParentIds items 54 | 55 | 56 | 57 | -- Tests 58 | 59 | 60 | functorTest : Test 61 | functorTest = 62 | describe "Act like functor" 63 | [ test "1st law" <| 64 | \() -> 65 | Expect.equal 66 | (Tree.map identity tree) 67 | (identity tree) 68 | , test "2nd law" <| 69 | \() -> 70 | let 71 | fc1 = 72 | toString 73 | 74 | fc2 str = 75 | "Hi " ++ str 76 | in 77 | Expect.equal 78 | (Tree.map (fc2 << fc1) tree) 79 | (Tree.map fc1 tree |> Tree.map fc2) 80 | ] 81 | 82 | 83 | filterTest : Test 84 | filterTest = 85 | let 86 | tree = 87 | [ Node.node "5" 5 [ Node.singleton "1" 1, Node.singleton "10" 10 ] ] 88 | in 89 | describe "filter" 90 | [ test "< 4" <| 91 | \() -> 92 | Expect.equal 93 | (Tree.filter ((<) 4) tree) 94 | ([ node "5" 5 [ node "10" 10 [] ] ]) 95 | , test "< 6" <| 96 | \() -> 97 | Expect.equal 98 | (Tree.filter ((<) 6) tree) 99 | [] 100 | , test "< 0" <| 101 | \() -> 102 | Expect.equal 103 | (Tree.filter ((<) 0) tree) 104 | tree 105 | ] 106 | 107 | 108 | deepFilterTest : Test 109 | deepFilterTest = 110 | let 111 | tree = 112 | [ Node.node "5" 5 [ Node.node "1" 1 [ Node.singleton "9" 9 ], Node.singleton "10" 10 ] ] 113 | in 114 | describe "filter node OR children" 115 | [ test "< 6" <| 116 | \() -> 117 | Expect.equal 118 | (Tree.deepFilter ((<) 6) tree) 119 | ([ Node.node "5" 5 ([ Node.node "1" 1 ([ Node.node "9" 9 [] ]), Node.node "10" 10 [] ]) ]) 120 | , test "< 11" <| 121 | \() -> 122 | Expect.equal 123 | (Tree.deepFilter ((<) 11) tree) 124 | [] 125 | , test "< 0" <| 126 | \() -> 127 | Expect.equal 128 | (Tree.deepFilter ((<) 0) tree) 129 | tree 130 | ] 131 | 132 | 133 | pushTest : Test 134 | pushTest = 135 | describe "push" 136 | [ test "to empty" <| 137 | \() -> 138 | Expect.equal 139 | (push toString Nothing 4 []) 140 | ([ node "4" 4 [] ]) 141 | , test "to root of existing" <| 142 | \() -> 143 | let 144 | item = 145 | { id = 4, name = "new", parentIds = [] } 146 | in 147 | Expect.equal 148 | (Tree.filter (\i -> i.id == 4) <| push itemId Nothing item tree) 149 | ([ node "4" item [] ]) 150 | , test "to deep level" <| 151 | \() -> 152 | let 153 | item = 154 | { id = 4, name = "new", parentIds = [ 3 ] } 155 | in 156 | Expect.equal 157 | (push itemId (Just "3") item tree) 158 | ([ node 159 | "1" 160 | { id = 1 161 | , name = "first" 162 | , parentIds = [] 163 | } 164 | [ node 165 | "2" 166 | { id = 2 167 | , name = "child" 168 | , parentIds = [ 1 ] 169 | } 170 | [ node 171 | "3" 172 | { id = 3 173 | , name = "deep child" 174 | , parentIds = [ 2 ] 175 | } 176 | [ node 177 | "4" 178 | { id = 4 179 | , name = "new" 180 | , parentIds = [ 3 ] 181 | } 182 | [] 183 | ] 184 | ] 185 | ] 186 | ] 187 | ) 188 | ] 189 | 190 | 191 | fromListTest : Test 192 | fromListTest = 193 | describe "fromList" 194 | [ test "resolve fixtures" <| 195 | \() -> 196 | Expect.equal 197 | tree 198 | ([ node 199 | "1" 200 | { id = 1 201 | , name = "first" 202 | , parentIds = [] 203 | } 204 | [ node 205 | "2" 206 | { id = 2 207 | , name = "child" 208 | , parentIds = [ 1 ] 209 | } 210 | [ node 211 | "3" 212 | { id = 3 213 | , name = "deep child" 214 | , parentIds = [ 2 ] 215 | } 216 | [] 217 | ] 218 | ] 219 | ] 220 | ) 221 | ] 222 | 223 | 224 | subTreeForTests : Test 225 | subTreeForTests = 226 | describe "subTreeFor" 227 | [ test "no id" <| 228 | \() -> 229 | Expect.equal (subTreeFor Nothing tree) ( tree, [] ) 230 | , test "root id" <| 231 | \() -> 232 | Expect.equal 233 | (subTreeFor (Just "1") tree) 234 | ( [ node 235 | "2" 236 | { id = 2, name = "child", parentIds = [ 1 ] } 237 | ([ node 238 | "3" 239 | { id = 3, name = "deep child", parentIds = [ 2 ] } 240 | [] 241 | ] 242 | ) 243 | ] 244 | , [ { id = 1, name = "first", parentIds = [] } ] 245 | ) 246 | , test "id the middle of the tree" <| 247 | \() -> 248 | Expect.equal 249 | (subTreeFor (Just "2") tree) 250 | ( [ node 251 | "3" 252 | { id = 3, name = "deep child", parentIds = [ 2 ] } 253 | [] 254 | ] 255 | , [ { id = 2, name = "child", parentIds = [ 1 ] } 256 | , { id = 1, name = "first", parentIds = [] } 257 | ] 258 | ) 259 | , test "leaf id" <| 260 | \() -> 261 | Expect.equal 262 | (subTreeFor (Just "3") tree) 263 | ( [] 264 | , [ { id = 3, name = "deep child", parentIds = [ 2 ] } 265 | , { id = 2, name = "child", parentIds = [ 1 ] } 266 | , { id = 1, name = "first", parentIds = [] } 267 | ] 268 | ) 269 | ] 270 | -------------------------------------------------------------------------------- /src/Chae/Tree.elm: -------------------------------------------------------------------------------- 1 | module Chae.Tree 2 | exposing 3 | ( Tree 4 | , nil 5 | , map 6 | , map2 7 | , zip 8 | , reduce 9 | , filter 10 | , deepFilter 11 | , push 12 | , fromList 13 | , subTreeFor 14 | ) 15 | 16 | {-| Tree is list of nodes. 17 | Tree is main data structure this package provides and this module implements the most essential functions 18 | which really differs from general Rose Tree implementation. Along side with functor functions 19 | trees support operation like `push`, `subTreeFor` and `fromList`. These functions make it easy to create 20 | and manipulate trees only by knowing Ids of items. 21 | 22 | 23 | # Definition 24 | 25 | @docs Tree 26 | 27 | 28 | # Constructors 29 | 30 | @docs nil, fromList 31 | 32 | 33 | # Query a Tree 34 | 35 | @docs subTreeFor 36 | 37 | 38 | # Common Operations 39 | 40 | @docs push 41 | 42 | 43 | # Map - Reduce 44 | 45 | @docs map, map2, zip, reduce, filter, deepFilter 46 | 47 | -} 48 | 49 | import Tuple 50 | import List 51 | import Chae.Id exposing (..) 52 | import Chae.Node as Node 53 | import Maybe exposing (Maybe(..)) 54 | 55 | 56 | -- Types 57 | 58 | 59 | {-| -} 60 | type alias Tree a = 61 | List (Node.Node a) 62 | 63 | 64 | {-| Construct empty tree 65 | Alias for [] 66 | -} 67 | nil : Tree a 68 | nil = 69 | [] 70 | 71 | 72 | {-| Map function over tree 73 | Similar to `List.map` but working with trees 74 | -} 75 | map : (a -> b) -> Tree a -> Tree b 76 | map fc = 77 | List.map <| Node.map fc 78 | 79 | 80 | {-| Map function over two trees to produce new tree from both combined 81 | Similar to `List.map2` but working with trees 82 | -} 83 | map2 : 84 | (a -> b -> c) 85 | -> Tree a 86 | -> Tree b 87 | -> Tree c 88 | map2 fc = 89 | List.map2 <| Node.map2 fc 90 | 91 | 92 | {-| Zip two trees to tree of tuple 93 | Similar to `List.zip` but working with trees 94 | -} 95 | zip : Tree a -> Tree b -> Tree ( a, b ) 96 | zip = 97 | map2 (,) 98 | 99 | 100 | {-| Reduce Tree by given function 101 | Similar to `List.foldr` but working with trees 102 | -} 103 | reduce : 104 | (a -> b -> b) 105 | -> b 106 | -> Tree a 107 | -> b 108 | reduce reducer = 109 | List.foldr <| flip <| Node.reduce reducer 110 | 111 | 112 | {-| Filter Tree. 113 | Similar to `List.filter` but working on trees. 114 | If parent node do not pass condition its children are no included in result 115 | 116 | tree = [Node.node "5" 5 [ Node.singleton "1" 1, Node.singleton "10" 10 ] ] 117 | 118 | filter ((<) 4) tree == [ Node "5" 5 ([Node "10" 10 []]) ] 119 | filter ((<) 6) tree == [] 120 | filter ((<) 0) tree == tree 121 | 122 | -} 123 | filter : 124 | (a -> Bool) 125 | -> Tree a 126 | -> Tree a 127 | filter fc = 128 | let 129 | sieve ( id, a, c ) acc = 130 | if fc a then 131 | Node.node id a (filter fc c) :: acc 132 | else 133 | acc 134 | in 135 | List.foldr (sieve << Node.toTuple) [] 136 | 137 | 138 | {-| Similar to `filter` but includes node when some of its child matches. 139 | 140 | tree = [ Node.node "5" 5 [ Node.node "1" 1 [ Node.singleton "9" 9 ], Node.singleton "10" 10 ] ] 141 | 142 | deepFilter ((<) 6) tree == [[ Node.node "5" 5 ([ Node.node "1" 1 ([ Node.node "9" 9 [] ]), Node.node "10" 10 [] ]) ]] 143 | deepFilter ((<) 11) tree == [] 144 | deepFilter ((<) 0) tree == tree 145 | 146 | -} 147 | deepFilter : 148 | (a -> Bool) 149 | -> Tree a 150 | -> Tree a 151 | deepFilter fc = 152 | let 153 | sieve ( id, a, c ) acc = 154 | let 155 | c_ = 156 | deepFilter fc c 157 | in 158 | if fc a || not (List.isEmpty c_) then 159 | Node.node id a c_ :: acc 160 | else 161 | acc 162 | in 163 | List.foldr (sieve << Node.toTuple) [] 164 | 165 | 166 | {-| Produce new tree with given item pushed under its parent. 167 | First argument is function from item to `Id/String`. 168 | 169 | Second argument is `Maybe Id` is ether: 170 | 171 | - `Nothing` => push to root 172 | 173 | - `Just parentId` => push to sub Tree 174 | 175 | push toId Nothing 1 [] == [Node "1" 1 []] 176 | push toId (Just (toId 1)) 2 [ Node.singleton "1" 1 ] == [Node "1" 1 ([Node "2" 2 []])] 177 | 178 | -} 179 | push : 180 | (a -> Id) 181 | -> Maybe Id 182 | -> a 183 | -> Tree a 184 | -> Tree a 185 | push getId maybeId item tree = 186 | case maybeId of 187 | Nothing -> 188 | Node.singleton (getId item) item :: tree 189 | 190 | Just id -> 191 | List.map (Node.pushDeep id (getId item) item) tree 192 | 193 | 194 | {-| Build `Tree` from given list of items. 195 | First argument is function from item to `Id/String`. 196 | Second argument is function from item to `List Id/List String`. 197 | 198 | items = 199 | [ { id = 1, name = "first", parentIds = [] } 200 | , { id = 2, name = "child", parentIds = [1] } 201 | , { id = 3, name = "deep child", parentIds = [2] } 202 | ] 203 | 204 | itemId item = 205 | toId (.id item ) 206 | 207 | itemParentIds item = 208 | .parentIds item |> List.map toId 209 | 210 | fromList itemId itemParentIds items == [Node "1" { id = 1, name = "first", parentIds = [] } ([Node "2" { id = 2, name = "child", parentIds = [1] } ([Node "3" { id = 3, name = "deep child", parentIds = [2] } []])])] 211 | 212 | -} 213 | fromList : 214 | (a -> Id) 215 | -> (a -> List Id) 216 | -> List a 217 | -> Tree a 218 | fromList getId getParentId list = 219 | fromList_ getId getParentId list Nothing 220 | 221 | 222 | fromList_ : 223 | (a -> Id) 224 | -> (a -> List Id) 225 | -> List a 226 | -> Maybe Id 227 | -> Tree a 228 | fromList_ getId getParentId list maybeId = 229 | let 230 | children = 231 | case maybeId of 232 | Nothing -> 233 | List.filter (List.isEmpty << getParentId) list 234 | 235 | Just id -> 236 | List.filter (List.member id << getParentId) list 237 | in 238 | List.map (\i -> Node.node (getId i) i (fromList_ getId getParentId list (Just (getId i)))) children 239 | 240 | 241 | {-| Returns sub `Tree` and ancestors for given `Id` and `Tree`. 242 | First argument is `Maybe Id` is ether: 243 | 244 | - `Nothing` => result is given tree (with empty ancestors `List`). 245 | - `Just parentId` => result is sub tree for node with `id == parentId`. 246 | 247 | Returns tuple containing sub tree and list of ancestors of that sub tree (from parent to root). 248 | 249 | items = 250 | [ { id = 1, name = "first", parentIds = [] } 251 | , { id = 2, name = "child", parentIds = [1] } 252 | , { id = 3, name = "dep categories", parentIds = [2] } 253 | ] 254 | 255 | itemId item = 256 | toId (.id item ) 257 | 258 | itemParentIds item = 259 | .parentIds item |> List.map toId 260 | 261 | tree = 262 | fromList itemId itemParentIds items 263 | 264 | subTreeFor Nothing tree == (tree, []) 265 | subTreeFor (Just "1") tree == ([Node "2" { id = 2, name = "child", parentIds = [1] } ([Node "3" { id = 3, name = "dep categories", parentIds = [2] } []])],[{ id = 1, name = "first", parentIds = [] }]) 266 | subTreeFor (Just "2") tree == ([Node "3" { id = 3, name = "dep categories", parentIds = [2] } []],[{ id = 2, name = "child", parentIds = [1] },{ id = 1, name = "first", parentIds = [] }]) 267 | 268 | -} 269 | subTreeFor : 270 | Maybe Id 271 | -> Tree a 272 | -> ( Tree a, List a ) 273 | subTreeFor maybeId tree = 274 | case maybeId of 275 | Just id -> 276 | subTreeFor_ id ( tree, [] ) 277 | 278 | Nothing -> 279 | ( tree, [] ) 280 | 281 | 282 | subTreeFor_ : 283 | Id 284 | -> ( Tree a, List a ) 285 | -> ( Tree a, List a ) 286 | subTreeFor_ id ( tree, ancestors ) = 287 | let 288 | matches = 289 | List.filter ((==) id << Node.id) tree 290 | 291 | nest ( _, item, children ) = 292 | ( children, item :: ancestors ) 293 | in 294 | case (List.head matches) of 295 | Just node -> 296 | nest <| Node.toTuple node 297 | 298 | Nothing -> 299 | List.foldr 300 | (\child acc -> 301 | let 302 | subMatches = 303 | subTreeFor_ id <| nest <| Node.toTuple child 304 | in 305 | if List.isEmpty <| Tuple.second subMatches then 306 | acc 307 | else 308 | subMatches 309 | ) 310 | ( [], [] ) 311 | tree 312 | --------------------------------------------------------------------------------