A generic Rose Tree.
Note: This library is designed to work with unique values attached to tree nodes. This is usually achievable using records having a unique id, though unicity checks should be performed by consumers of this library.
A Rose Tree. Each node contains a value and children, which are themselves Nodes:
myTree : Tree Int
myTree =
Node 1
[ Node 2
[ Node 3 []
, Node 4 []
]
, Node 5 []
]
Create a Node. Basically just an alias for the Node
constructor.
Create a node having no children (singleton).
leaf "foo"
--> Node "foo" []
Append a new value to a Node identified by its value in a Tree.
node "foo" [ leaf "bar"]
|> append "foo" "baz"
--> node "foo" [ leaf "bar", leaf "baz" ]
Prepend a new value to a Node identified by its value in a Tree.
node "foo" [ leaf "bar"]
|> prepend "foo" "baz"
--> node "foo" [ leaf "baz", leaf "bar" ]
Deletes all occurrences of a value from a tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> remove "bar"
--> node "root" [ leaf "foo" ]
Noop when the value doesn't exist in the tree:
node "root" [ leaf "foo" ]
|> remove "non-existent"
--> node "root" [ leaf "foo" ]
Or when attempting to delete the tree itself:
leaf "root"
|> remove "root"
--> leaf "root"
Seed a tree.
seed (\x -> List.range 1 (x - 1)) 4
--> node 4
--> [ leaf 1
--> , node 2 [ leaf 1 ]
--> , node 3
--> [ leaf 1
--> , node 2 [ leaf 1 ]
--> ]
--> ]
Extract the value of a Node.
leaf 2 |> value
--> 2
List all the values in a tree.
node 1 [ node 2 [ leaf 3 ] ]
|> values
--> [ 1, 2, 3 ]
Extracts the children of a Node.
node "foo" [ leaf "bar" ]
|> children
--> [ leaf "bar" ]
Count nodes in a tree.
node 1 [node 2 [ node 3 [ leaf 4 ] ] ]
|> length
--> 4
Get a Node holding a value from a tree, picking the first node found starting from the left.
node "root" [ leaf "bar" ]
|> get "bar"
--> Just (leaf "bar")
Get all nodes containing the provided value.
node 1 [ leaf 1 ]
|> getAll 1
--> [ node 1 [ leaf 1 ], leaf 1 ]
Retrieve all leaves (singletons) from a tree.
node "root"
[ leaf "a leaf"
, node "branch"
[ leaf "another leaf" ]
]
|> leaves
--> [ "a leaf", "another leaf" ]
Retrieve all nodes at a given level in the tree.
node "root"
[ node "1" [ node "1.1" [ leaf "1.1.1" ] ]
, node "2" [ node "2.1" [ leaf "2.1.1" ] ]
]
|> level 3
--> [ leaf "1.1.1"
--> , leaf "2.1.1"
--> ]
node "root"
[ node "1" [ node "1.1" [ leaf "1.1.1" ] ]
, node "2" [ node "2.1" [ leaf "2.1.1" ] ]
]
|> level 2
--> [ node "1.1" [ leaf "1.1.1" ]
--> , node "2.1" [ leaf "2.1.1" ]
--> ]
Compute the maximum value appearing in a tree.
node 1 [ leaf 100, node 2 [ leaf 3 ] ]
|> maximum
--> 100
Compute the minimum value appearing in a tree.
node 100 [ leaf 99, node 1 [ leaf 98 ] ]
|> minimum
--> 1
Retrieve the parent of a given node in a Tree, identified by its value.
node "root" [ node "foo" [ leaf "bar" ] ]
|> parent "bar"
--> Just (node "foo" [ leaf "bar" ])
Compute the path to a the first node holding the target value, from the root.
node "root"
[ leaf "qux"
, node "foo"
[ node "bar"
[ leaf "baz" ]
]
]
|> path "baz"
|> List.map value
--> [ "root", "foo", "bar", "baz" ]
Retrieve all values from nodes containing those satisfying a provided condition.
node 1 [ node 2 [ leaf 3, leaf 4, leaf 5 ] ]
|> seek (\x -> x > 3)
--> [ leaf 4, leaf 5 ]
Retrieve siblings of a node identified by its value in a Tree.
node "foo" [ leaf "a", node "b" [ leaf "x" ], leaf "c" ]
|> siblings "c"
--> [ leaf "a", node "b" [ leaf "x" ] ]
Check that all values satisfy a test in a tree.
node 1 [ leaf 2 ]
|> all (\x -> x > 0)
--> True
node 1 [leaf -2]
|> all (\x -> x > 0)
--> False
Check that any value satisfy a test in a tree.
node 1 [ leaf -2 ]
|> any (\x -> x > 0)
--> True
node -1 [ leaf -2 ]
|> any (\x -> x > 0)
--> False
Check if a tree contains a value.
node "foo" [ node "bar" [ leaf "baz" ] ]
|> member "baz"
--> True
leaf "no"
|> member "yes"
--> False
Map a Node's children.
node "root" [ leaf "foo", leaf "bar" ]
|> mapChildren (map String.toUpper)
--> node "root" [ leaf "FOO", leaf "BAR" ]
Replace the children of a Node.
Replace the value of a Node.
Update a Node value using an update function. This is especially useful for updating record properties.
leaf { name = "root" }
|> updateValue (\r -> { r | name = r.name ++ "!"})
--> leaf { name = "root!" }
Map a targetted Node's children in a tree.
node 1 [ node 2 [ leaf 3, leaf 4 ] ]
|> mapChildrenAt 2 (updateValue ((*) 2))
--> node 1 [ node 2 [ leaf 6, leaf 8 ] ]
Replace all Nodes holding a given value with a new Node in a Tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> replaceAt "foo" (leaf "bar")
--> node "root" [ leaf "bar" ]
node "root" [ leaf "foo", leaf "foo" ]
|> replaceAt "foo" (leaf "bar")
--> node "root" [ leaf "bar", leaf "bar" ]
Replace a targetted Node's children in a tree.
node 1 [ node 2 [ leaf 3, leaf 4 ] ]
|> replaceChildrenAt 2 [ leaf 5 ]
--> node 1 [ node 2 [ leaf 5 ] ]
Replace a targetted Node value with another one in a Tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> replaceValueAt "foo" "baz"
--> node "root" [ node "baz" [ leaf "bar" ] ]
node "root" [ leaf "foo", leaf "foo" ]
|> replaceValueAt "foo" "bar"
--> node "root" [ leaf "bar", leaf "bar" ]
Update a targetted Node in a tree, using an update function.
node 1 [ node 2 [ leaf 3 ] ]
|> updateAt 3 (always (leaf 42))
--> node 1 [ node 2 [ leaf 42 ] ]
Update a targetted Node value in a tree, using an update function.
node 1 [ node 2 [ leaf 3 ] ]
|> updateValueAt 3 ((*) 2)
--> node 1 [ node 2 [ leaf 6 ] ]
Filter a Tree strictly, removing all nodes failing the provided value test, including root, hence the resulting Maybe.
node 0 [ leaf 1 ]
|> filter (\x -> x > 0)
--> Nothing
node 2 [ leaf 3, leaf 4 ]
|> filter (\x -> x % 2 == 0)
--> Just (node 2 [ leaf 4 ])
Map each node using a mapping function then flatten the result into a new list.
node "foo" [ node "bar" [ leaf "baz" ] ]
|> flatMap (value >> String.toUpper)
--> [ "FOO", "BAR", "BAZ" ]
Flatten a Tree, from top to bottom and leftmost nodes to rightmost ones.
node "root" [ node "foo" [ leaf "bar", leaf "baz" ] ]
|> flatten
--> [ node "root" [ node "foo" [ leaf "bar", leaf "baz" ] ]
--> , node "foo" [ leaf "bar", leaf "baz" ]
--> , leaf "bar"
--> , leaf "baz"
--> ]
Reduce all tree values from top to bottom, left to right.
node 1 [ node 2 [ leaf 3 ] ]
|> foldl (+) 0
--> 6
node "a"
[ node "b" [ leaf "c" ]
, node "d" [ node "e" [ leaf "f" ] ]
, leaf "g"
]
|> foldl (\value acc -> acc ++ value) ""
--> "abcdefg"
Reduce all tree values from top to bottom, right to left.
node "a"
[ node "b" [ leaf "c" ]
, node "d" [ node "e" [ leaf "f" ] ]
, leaf "g"
]
|> foldr (\value acc -> acc ++ value) ""
--> "gfedcba"
Map all Node values in a Tree.
node "root" [ leaf "foo", node "bar" [ leaf "baz" ] ]
|> map String.toUpper
--> node "ROOT" [ leaf "FOO", node "BAR" [ leaf "BAZ" ] ]
Filter a Tree, keeping only nodes which attached leaves satisfy the provided test and preserving their ancestors, up to the tree root, which is always kept.
node 2
[ node 4
[ leaf 6
, leaf 7
, node 8
[ leaf 10
, leaf 11
, leaf 12
, leaf 13
]
]
]
|> refine (\x -> x % 2 == 0)
--> node 2
--> [ node 4
--> [ leaf 6
--> , node 8
--> [ leaf 10
--> , leaf 12
--> ]
--> ]
--> ]
Recursively sort node children from a tree using a sorter.
node 0 [ leaf 3, leaf 1, leaf 2 ]
|> sortBy identity
--> node 0 [ leaf 1, leaf 2, leaf 3 ]
Recursively sort node children from a tree using a comparator.
node 0 [ leaf 3, leaf 1, leaf 2 ]
|> sortWith (\a b -> if a == b then EQ else if a < b then GT else LT)
--> node 0 [ leaf 3, leaf 2, leaf 1 ]
Turn a Node into a tuple containing the value and the parent value, if any.
Build a tree from a list of hierarchy descriptors, which are tuples of value and parent value, starting with the root.
[ ( "root", Nothing )
, ( "foo", Just "root" )
, ( "bar", Just "foo" )
]
|> fromList
--> Just (node "root" [ node "foo" [ leaf "bar" ] ])
Turn a tree of node into a list of tuples.
node "root" [ node "foo" [ leaf "bar" ], leaf "baz" ]
|> toList
--> [ ( "root", Nothing )
--> , ( "foo", Just "root")
--> , ( "bar", Just "foo")
--> , ( "baz", Just "root")
--> ]
A JSON Node decoder. You must specify a decoder for values.
import Json.Decode as Decode
json : String
json = "{\"value\":\"foo\",\"children\":[{\"value\":\"bar\",\"children\":[]}]}"
Decode.decodeString (decode Decode.string) json
--> Ok (node "foo" [ leaf "bar" ])
Encode a Node to JSON. You must provide an encoder for values.
import Json.Encode as Encode
node "foo" [ leaf "bar" ]
|> encode Encode.string
|> Encode.encode 0
--> "{\"value\":\"foo\",\"children\":[{\"value\":\"bar\",\"children\":[]}]}"
module Canopy
exposing
( Node(..)
, all
, any
, append
, children
, decode
, encode
, filter
, flatMap
, flatten
, foldl
, foldr
, fromList
, get
, getAll
, leaf
, leaves
, length
, level
, map
, mapChildren
, mapChildrenAt
, maximum
, minimum
, member
, node
, parent
, path
, prepend
, remove
, refine
, replaceAt
, replaceChildren
, replaceChildrenAt
, replaceValue
, replaceValueAt
, seed
, seek
, siblings
, sortBy
, sortWith
, toList
, tuple
, updateAt
, updateValue
, updateValueAt
, value
, values
)
{-| A generic [Rose Tree](https://en.wikipedia.org/wiki/Rose_tree).
**Note:** This library is designed to work with unique values attached to tree nodes.
This is usually achievable using records having a unique id, though unicity checks should
be performed by consumers of this library.
@docs Node
# Building a tree
@docs node, leaf, append, prepend, remove, seed
# Querying a tree
@docs value, values, children, length, get, getAll, leaves, level, maximum, minimum, parent, path, seek, siblings
# Checking a tree
@docs all, any, member
# Manipulating a tree
## Single-level operations
@docs mapChildren, replaceChildren, replaceValue, updateValue
## Deep operations
@docs mapChildrenAt, replaceAt, replaceChildrenAt, replaceValueAt, updateAt , updateValueAt
## Common operations
@docs filter, flatMap, flatten, foldl, foldr, map, refine, sortBy, sortWith, tuple
# Importing and exporting
@docs fromList, toList, decode, encode
-}
import Json.Decode as Decode exposing (Decoder)
import Json.Encode as Encode
{-| A [Rose Tree](https://en.wikipedia.org/wiki/Rose_tree). Each node contains a
value and children, which are themselves Nodes:
myTree : Tree Int
myTree =
Node 1
[ Node 2
[ Node 3 []
, Node 4 []
]
, Node 5 []
]
-}
type Node a
= Node a (List (Node a))
{-| Check that all values satisfy a test in a tree.
node 1 [ leaf 2 ]
|> all (\x -> x > 0)
--> True
node 1 [leaf -2]
|> all (\x -> x > 0)
--> False
-}
all : (a -> Bool) -> Node a -> Bool
all test =
values >> List.all test
{-| Check that any value satisfy a test in a tree.
node 1 [ leaf -2 ]
|> any (\x -> x > 0)
--> True
node -1 [ leaf -2 ]
|> any (\x -> x > 0)
--> False
-}
any : (a -> Bool) -> Node a -> Bool
any test =
values >> List.any test
{-| Append a new value to a Node identified by its value in a Tree.
node "foo" [ leaf "bar"]
|> append "foo" "baz"
--> node "foo" [ leaf "bar", leaf "baz" ]
-}
append : a -> a -> Node a -> Node a
append target child node =
if target == value node then
node |> replaceChildren (children node ++ [ leaf child ])
else
node |> mapChildren (append target child)
{-| Extracts the children of a Node.
node "foo" [ leaf "bar" ]
|> children
--> [ leaf "bar" ]
-}
children : Node a -> List (Node a)
children (Node _ children) =
children
{-| A JSON Node decoder. You must specify a decoder for values.
import Json.Decode as Decode
json : String
json = "{\"value\":\"foo\",\"children\":[{\"value\":\"bar\",\"children\":[]}]}"
Decode.decodeString (decode Decode.string) json
--> Ok (node "foo" [ leaf "bar" ])
-}
decode : Decoder a -> Decoder (Node a)
decode decodeDatum =
Decode.map2 Node
(Decode.field "value" decodeDatum)
(Decode.field "children" (Decode.list (Decode.lazy (\_ -> decode decodeDatum))))
{-| Encode a Node to JSON. You must provide an encoder for values.
import Json.Encode as Encode
node "foo" [ leaf "bar" ]
|> encode Encode.string
|> Encode.encode 0
--> "{\"value\":\"foo\",\"children\":[{\"value\":\"bar\",\"children\":[]}]}"
-}
encode : (a -> Encode.Value) -> Node a -> Encode.Value
encode valueEncoder (Node value children) =
Encode.object
[ ( "value", valueEncoder value )
, ( "children", children |> List.map (encode valueEncoder) |> Encode.list )
]
{-| Filter a Tree strictly, removing all nodes failing the provided value test,
including root, hence the resulting Maybe.
node 0 [ leaf 1 ]
|> filter (\x -> x > 0)
--> Nothing
node 2 [ leaf 3, leaf 4 ]
|> filter (\x -> x % 2 == 0)
--> Just (node 2 [ leaf 4 ])
-}
filter : (a -> Bool) -> Node a -> Maybe (Node a)
filter test tree =
if test (value tree) then
let
newChildren =
tree
|> children
|> List.filter (value >> test)
|> List.filterMap (filter test)
in
tree |> replaceChildren newChildren |> Just
else
Nothing
{-| Map each node using a mapping function then flatten the result into a new list.
node "foo" [ node "bar" [ leaf "baz" ] ]
|> flatMap (value >> String.toUpper)
--> [ "FOO", "BAR", "BAZ" ]
-}
flatMap : (Node a -> b) -> Node a -> List b
flatMap mapper tree =
List.foldl
(\node acc ->
acc
++ mapper node
:: (children node |> List.map (flatMap mapper) |> List.concat)
)
[ mapper tree ]
(children tree)
{-| Flatten a Tree, from top to bottom and leftmost nodes to rightmost ones.
node "root" [ node "foo" [ leaf "bar", leaf "baz" ] ]
|> flatten
--> [ node "root" [ node "foo" [ leaf "bar", leaf "baz" ] ]
--> , node "foo" [ leaf "bar", leaf "baz" ]
--> , leaf "bar"
--> , leaf "baz"
--> ]
-}
flatten : Node a -> List (Node a)
flatten =
flatMap identity
{-| Reduce all tree values from top to bottom, left to right.
node 1 [ node 2 [ leaf 3 ] ]
|> foldl (+) 0
--> 6
node "a"
[ node "b" [ leaf "c" ]
, node "d" [ node "e" [ leaf "f" ] ]
, leaf "g"
]
|> foldl (\value acc -> acc ++ value) ""
--> "abcdefg"
-}
foldl : (a -> b -> b) -> b -> Node a -> b
foldl fn acc =
values >> List.foldl fn acc
{-| Reduce all tree values from top to bottom, right to left.
node "a"
[ node "b" [ leaf "c" ]
, node "d" [ node "e" [ leaf "f" ] ]
, leaf "g"
]
|> foldr (\value acc -> acc ++ value) ""
--> "gfedcba"
-}
foldr : (a -> b -> b) -> b -> Node a -> b
foldr fn acc =
values >> List.foldr fn acc
{-| Build a tree from a list of hierarchy descriptors, which are tuples of value
and parent value, starting with the root.
[ ( "root", Nothing )
, ( "foo", Just "root" )
, ( "bar", Just "foo" )
]
|> fromList
--> Just (node "root" [ node "foo" [ leaf "bar" ] ])
-}
fromList : List ( a, Maybe a ) -> Maybe (Node a)
fromList nodes =
case List.head nodes of
Just ( root, Nothing ) ->
nodes
|> List.foldl
(\( value, maybeParent ) acc ->
maybeParent
|> Maybe.map (\parent -> append parent value acc)
|> Maybe.withDefault acc
)
(leaf root)
|> Just
_ ->
Nothing
{-| Get a Node holding a value from a tree, picking the first node found starting
from the left.
node "root" [ leaf "bar" ]
|> get "bar"
--> Just (leaf "bar")
-}
get : a -> Node a -> Maybe (Node a)
get target =
getAll target >> List.head
{-| Get all nodes containing the provided value.
node 1 [ leaf 1 ]
|> getAll 1
--> [ node 1 [ leaf 1 ], leaf 1 ]
-}
getAll : a -> Node a -> List (Node a)
getAll target =
flatten >> List.filter (value >> (==) target)
{-| Create a node having no children (singleton).
leaf "foo"
--> Node "foo" []
-}
leaf : a -> Node a
leaf value =
Node value []
{-| Retrieve all leaves (singletons) from a tree.
node "root"
[ leaf "a leaf"
, node "branch"
[ leaf "another leaf" ]
]
|> leaves
--> [ "a leaf", "another leaf" ]
-}
leaves : Node a -> List a
leaves =
flatten >> List.filter (children >> (==) []) >> List.map value
{-| Count nodes in a tree.
node 1 [node 2 [ node 3 [ leaf 4 ] ] ]
|> length
--> 4
-}
length : Node a -> Int
length =
foldl (\_ x -> x + 1) 0
{-| Retrieve all nodes at a given level in the tree.
node "root"
[ node "1" [ node "1.1" [ leaf "1.1.1" ] ]
, node "2" [ node "2.1" [ leaf "2.1.1" ] ]
]
|> level 3
--> [ leaf "1.1.1"
--> , leaf "2.1.1"
--> ]
node "root"
[ node "1" [ node "1.1" [ leaf "1.1.1" ] ]
, node "2" [ node "2.1" [ leaf "2.1.1" ] ]
]
|> level 2
--> [ node "1.1" [ leaf "1.1.1" ]
--> , node "2.1" [ leaf "2.1.1" ]
--> ]
-}
level : Int -> Node a -> List (Node a)
level lvl =
if lvl <= 0 then
List.singleton
else
children >> List.map (level (lvl - 1)) >> List.concat
{-| Map all Node values in a Tree.
node "root" [ leaf "foo", node "bar" [ leaf "baz" ] ]
|> map String.toUpper
--> node "ROOT" [ leaf "FOO", node "BAR" [ leaf "BAZ" ] ]
-}
map : (a -> b) -> Node a -> Node b
map mapper (Node value children) =
Node (mapper value) (children |> List.map (map mapper))
{-| Map a Node's children.
node "root" [ leaf "foo", leaf "bar" ]
|> mapChildren (map String.toUpper)
--> node "root" [ leaf "FOO", leaf "BAR" ]
-}
mapChildren : (Node a -> Node a) -> Node a -> Node a
mapChildren mapper (Node value children) =
Node value (List.map mapper children)
{-| Map a targetted Node's children in a tree.
node 1 [ node 2 [ leaf 3, leaf 4 ] ]
|> mapChildrenAt 2 (updateValue ((*) 2))
--> node 1 [ node 2 [ leaf 6, leaf 8 ] ]
-}
mapChildrenAt : a -> (Node a -> Node a) -> Node a -> Node a
mapChildrenAt target mapper root =
case get target root of
Just node ->
root |> replaceAt target (mapChildren mapper node)
Nothing ->
root
{-| Compute the maximum value appearing in a tree.
node 1 [ leaf 100, node 2 [ leaf 3 ] ]
|> maximum
--> 100
-}
maximum : Node comparable -> comparable
maximum node =
node |> values |> List.maximum |> Maybe.withDefault (value node)
{-| Compute the minimum value appearing in a tree.
node 100 [ leaf 99, node 1 [ leaf 98 ] ]
|> minimum
--> 1
-}
minimum : Node comparable -> comparable
minimum node =
node |> values |> List.minimum |> Maybe.withDefault (value node)
{-| Check if a tree contains a value.
node "foo" [ node "bar" [ leaf "baz" ] ]
|> member "baz"
--> True
leaf "no"
|> member "yes"
--> False
-}
member : a -> Node a -> Bool
member target node =
node |> get target |> Maybe.map (always True) |> Maybe.withDefault False
{-| Create a Node. Basically just an alias for the `Node` constructor.
-}
node : a -> List (Node a) -> Node a
node =
Node
{-| Retrieve the parent of a given node in a Tree, identified by its value.
node "root" [ node "foo" [ leaf "bar" ] ]
|> parent "bar"
--> Just (node "foo" [ leaf "bar" ])
-}
parent : a -> Node a -> Maybe (Node a)
parent target candidate =
candidate
|> children
|> List.foldl
(\node acc ->
case acc of
Just found ->
Just found
Nothing ->
if value node == target then
Just candidate
else
parent target node
)
Nothing
{-| Compute the path to a the first node holding the target value, from the root.
node "root"
[ leaf "qux"
, node "foo"
[ node "bar"
[ leaf "baz" ]
]
]
|> path "baz"
|> List.map value
--> [ "root", "foo", "bar", "baz" ]
-}
path : a -> Node a -> List (Node a)
path target rootNode =
case ( get target rootNode, parent target rootNode ) of
( Just found, Nothing ) ->
[ found ]
( Just found, Just parent ) ->
path (value parent) rootNode ++ [ found ]
_ ->
[]
{-| Prepend a new value to a Node identified by its value in a Tree.
node "foo" [ leaf "bar"]
|> prepend "foo" "baz"
--> node "foo" [ leaf "baz", leaf "bar" ]
-}
prepend : a -> a -> Node a -> Node a
prepend target child node =
if target == value node then
node |> replaceChildren (leaf child :: children node)
else
node |> mapChildren (prepend target child)
{-| Deletes all occurrences of a value from a tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> remove "bar"
--> node "root" [ leaf "foo" ]
Noop when the value doesn't exist in the tree:
node "root" [ leaf "foo" ]
|> remove "non-existent"
--> node "root" [ leaf "foo" ]
Or when attempting to delete the tree itself:
leaf "root"
|> remove "root"
--> leaf "root"
-}
remove : a -> Node a -> Node a
remove target tree =
tree |> filter ((/=) target) |> Maybe.withDefault tree
{-| Filter a Tree, keeping only nodes which attached leaves satisfy the
provided test and preserving their ancestors, up to the tree root, which is
always kept.
node 2
[ node 4
[ leaf 6
, leaf 7
, node 8
[ leaf 10
, leaf 11
, leaf 12
, leaf 13
]
]
]
|> refine (\x -> x % 2 == 0)
--> node 2
--> [ node 4
--> [ leaf 6
--> , node 8
--> [ leaf 10
--> , leaf 12
--> ]
--> ]
--> ]
-}
refine : (a -> Bool) -> Node a -> Node a
refine test tree =
let
toDelete =
tree |> seek (not << test)
toPreserve =
tree
|> seek test
|> List.map (\(Node val _) -> tree |> path val |> List.map value)
|> List.concat
in
toDelete
|> List.filter (\(Node value _) -> List.member value toPreserve |> not)
|> List.map value
|> List.foldl remove tree
{-| Replace all Nodes holding a given value with a new Node in a Tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> replaceAt "foo" (leaf "bar")
--> node "root" [ leaf "bar" ]
node "root" [ leaf "foo", leaf "foo" ]
|> replaceAt "foo" (leaf "bar")
--> node "root" [ leaf "bar", leaf "bar" ]
-}
replaceAt : a -> Node a -> Node a -> Node a
replaceAt target replacement root =
if value root == target then
replacement
else
root |> mapChildren (replaceAt target replacement)
{-| Replace the children of a Node.
-}
replaceChildren : List (Node a) -> Node a -> Node a
replaceChildren children (Node value _) =
Node value children
{-| Replace a targetted Node's children in a tree.
node 1 [ node 2 [ leaf 3, leaf 4 ] ]
|> replaceChildrenAt 2 [ leaf 5 ]
--> node 1 [ node 2 [ leaf 5 ] ]
-}
replaceChildrenAt : a -> List (Node a) -> Node a -> Node a
replaceChildrenAt target children root =
case get target root of
Just node ->
root |> replaceAt target (replaceChildren children node)
Nothing ->
root
{-| Replace the value of a Node.
-}
replaceValue : a -> Node a -> Node a
replaceValue value (Node _ children) =
Node value children
{-| Replace a targetted Node value with another one in a Tree.
node "root" [ node "foo" [ leaf "bar" ] ]
|> replaceValueAt "foo" "baz"
--> node "root" [ node "baz" [ leaf "bar" ] ]
node "root" [ leaf "foo", leaf "foo" ]
|> replaceValueAt "foo" "bar"
--> node "root" [ leaf "bar", leaf "bar" ]
-}
replaceValueAt : a -> a -> Node a -> Node a
replaceValueAt target replacement root =
case get target root of
Just node ->
root |> replaceAt target (replaceValue replacement node)
Nothing ->
root
{-| Retrieve all values from nodes containing those satisfying a provided condition.
node 1 [ node 2 [ leaf 3, leaf 4, leaf 5 ] ]
|> seek (\x -> x > 3)
--> [ leaf 4, leaf 5 ]
-}
seek : (a -> Bool) -> Node a -> List (Node a)
seek test =
flatten >> List.filter (value >> test)
{-| Seed a tree.
seed (\x -> List.range 1 (x - 1)) 4
--> node 4
--> [ leaf 1
--> , node 2 [ leaf 1 ]
--> , node 3
--> [ leaf 1
--> , node 2 [ leaf 1 ]
--> ]
--> ]
-}
seed : (a -> List a) -> a -> Node a
seed seeder init =
Node init (seeder init |> List.map (seed seeder))
{-| Retrieve siblings of a node identified by its value in a Tree.
node "foo" [ leaf "a", node "b" [ leaf "x" ], leaf "c" ]
|> siblings "c"
--> [ leaf "a", node "b" [ leaf "x" ] ]
-}
siblings : a -> Node a -> List (Node a)
siblings target tree =
case parent target tree of
Just (Node _ children) ->
children |> List.filter (value >> (/=) target)
Nothing ->
[]
{-| Recursively sort node children from a tree using a sorter.
node 0 [ leaf 3, leaf 1, leaf 2 ]
|> sortBy identity
--> node 0 [ leaf 1, leaf 2, leaf 3 ]
-}
sortBy : (a -> comparable) -> Node a -> Node a
sortBy sorter (Node val children) =
children
|> List.sortBy (value >> sorter)
|> List.map (sortBy sorter)
|> Node val
{-| Recursively sort node children from a tree using a comparator.
node 0 [ leaf 3, leaf 1, leaf 2 ]
|> sortWith (\a b -> if a == b then EQ else if a < b then GT else LT)
--> node 0 [ leaf 3, leaf 2, leaf 1 ]
-}
sortWith : (a -> a -> Order) -> Node a -> Node a
sortWith comparator (Node val children) =
children
|> List.sortWith (\a b -> comparator (value a) (value b))
|> List.map (sortWith comparator)
|> Node val
{-| Turn a tree of node into a list of tuples.
node "root" [ node "foo" [ leaf "bar" ], leaf "baz" ]
|> toList
--> [ ( "root", Nothing )
--> , ( "foo", Just "root")
--> , ( "bar", Just "foo")
--> , ( "baz", Just "root")
--> ]
-}
toList : Node a -> List ( a, Maybe a )
toList node =
node |> flatMap (tuple node)
{-| Turn a Node into a tuple containing the value and the parent value, if any.
-}
tuple : Node a -> Node a -> ( a, Maybe a )
tuple root node =
( value node, root |> parent (value node) |> Maybe.map value )
{-| Update a targetted Node in a tree, using an update function.
node 1 [ node 2 [ leaf 3 ] ]
|> updateAt 3 (always (leaf 42))
--> node 1 [ node 2 [ leaf 42 ] ]
-}
updateAt : a -> (Node a -> Node a) -> Node a -> Node a
updateAt target update root =
if value root == target then
update root
else
root |> mapChildren (updateAt target update)
{-| Update a Node value using an update function. This is especially useful for
updating record properties.
leaf { name = "root" }
|> updateValue (\r -> { r | name = r.name ++ "!"})
--> leaf { name = "root!" }
-}
updateValue : (a -> a) -> Node a -> Node a
updateValue update_ (Node value children) =
Node (update_ value) children
{-| Update a targetted Node value in a tree, using an update function.
node 1 [ node 2 [ leaf 3 ] ]
|> updateValueAt 3 ((*) 2)
--> node 1 [ node 2 [ leaf 6 ] ]
-}
updateValueAt : a -> (a -> a) -> Node a -> Node a
updateValueAt target update =
updateAt target (updateValue update)
{-| Extract the value of a Node.
leaf 2 |> value
--> 2
-}
value : Node a -> a
value (Node value _) =
value
{-| List all the values in a tree.
node 1 [ node 2 [ leaf 3 ] ]
|> values
--> [ 1, 2, 3 ]
-}
values : Node a -> List a
values =
flatten >> List.map value