Skip to content

Instantly share code, notes, and snippets.

@rupertlssmith
Last active July 2, 2018 11:12
Show Gist options
  • Save rupertlssmith/52e844974e91fb46c1ae8932c5d93e15 to your computer and use it in GitHub Desktop.
Save rupertlssmith/52e844974e91fb46c1ae8932c5d93e15 to your computer and use it in GitHub Desktop.
The 'tea-tree' data structure is a rose-tree implementation with some additional features that help when working with the Elm update cycle.

The 'tea-tree' data structure is a rose-tree implementation with some additional features that help when working with the Elm update cycle.

In TEA update messages should contain only enough information to perform a 'delta' on the Model to derive a new Model. State from the model itself should not be captured, as it may get stale. Updates are asynchronous, so it is possible to have >1 Cmd in flight at the same time, which are derived from the same version of the Model.

Every node in the tree is assigned a unique id.

  • This means that when re-walking a tree to the same position, this can be verified.
  • The nodes in the tree can potentially be updated faster, by using Array.map

A position in the tree can have a Path extracted, which can be used to return to the same point in the tree later. This can be passed with messages attached to Elm Cmds, to associate only a position within a tree, not the data at that position.

  • This avoid the stale update problem.

Implementation below is a work in progress.

module Tree
exposing
( Tree
, Zipper
, Path
-- Tree operations
, singleton
, zipper
, map
-- Zipper operations
, goToChild
, goToRightMostChild
, goUp
, goLeft
, goRight
, goToRoot
-- , goToNext
-- , goToPrevious
-- , goTo
, updateFocusDatum
, datum
-- , insertChild
-- , updateChildren
, getPath
-- Path operations
-- , goToPath
-- , updateDatum
)
-- It will be a multiway Tree implementation, not a binary tree.
--
-- Will save this for an optimized version:
-- type alias NodeArray a =
-- Array Int a
--
-- Need to add API for simpler read-only walking of the tree. Zippers will churn
-- the heap, but a read only pass for rendering the view does not need them so
-- can be made more efficient.
type alias Id =
Int
type Tree a
= Tree
{ nextId : Id
, innerTree : InnerTree a
}
type Zipper a
= Zipper
{ nextId : Id
, currentPath : Path
, innerTree : InnerTree a
, crumbs : Breadcrumbs a
}
type Path
= Path Id (List Int)
type InnerTree a
= InnerTree
{ id : Id
, datum : a
, children : Forest a
}
type alias Forest a =
List (InnerTree a)
type alias Context a =
{ id : Id
, datum : a
, before : Forest a
, after : Forest a
}
type alias Breadcrumbs a =
List (Context a)
-- Id operations
getNextId : Id -> Id
getNextId id =
id + 1
-- Tree operations
singleton : a -> Tree a
singleton datum =
Tree
{ nextId = 0
, innerTree =
InnerTree
{ id = 0
, datum = datum
, children = []
}
}
zipper : Tree a -> Zipper a
zipper (Tree tree) =
Zipper
{ nextId = tree.nextId
, currentPath =
case tree.innerTree of
InnerTree inner ->
Path inner.id []
, innerTree = tree.innerTree
, crumbs = []
}
mapInner : (a -> b) -> InnerTree a -> InnerTree b
mapInner fn (InnerTree tree) =
let
mappedDatum =
fn tree.datum
mappedChildren =
List.map (\child -> mapInner fn child) tree.children
in
(InnerTree
{ id = tree.id
, datum = mappedDatum
, children = mappedChildren
}
)
map : (a -> b) -> Tree a -> Tree b
map fn (Tree tree) =
let
mappedInner =
mapInner fn tree.innerTree
in
(Tree
{ nextId = tree.nextId
, innerTree = mappedInner
}
)
{-| This operation may be faster than `map` when the type of the tree does not change.
It should be preferred to `map` in that case.
-}
update : (a -> a) -> Tree a -> Tree a
update fn tree =
map fn tree
-- Zipper operations
splitOnIndex : Int -> List (InnerTree a) -> Maybe ( Forest a, InnerTree a, Forest a )
splitOnIndex n xs =
let
before =
List.take n xs
focus =
List.drop n xs |> List.head
after =
List.drop (n + 1) xs
-- The above seems inneficient unless the compiler is very smart,
-- better to write our own loop to iterate the list just once.
in
case focus of
Nothing ->
Nothing
Just f ->
Just ( before, f, after )
{-| Walking the zipper context back to the root will produce a Tree with any
updates made as the zipper was walked over the tree, folded back in to the
new Tree.
-}
goToRoot : Zipper a -> Zipper a
goToRoot (Zipper zipper) =
case zipper.crumbs of
[] ->
Zipper zipper
otherwise ->
goUp (Zipper zipper)
|> Maybe.map goToRoot
|> Maybe.withDefault (Zipper zipper)
goToChild : Int -> Zipper a -> Maybe (Zipper a)
goToChild n (Zipper zipper) =
let
(InnerTree inner) =
zipper.innerTree
maybeSplit =
splitOnIndex n inner.children
in
case maybeSplit of
Nothing ->
Nothing
Just ( before, focus, after ) ->
let
(InnerTree innerFocus) =
focus
in
Just
(Zipper
{ nextId = zipper.nextId
, currentPath =
case zipper.currentPath of
Path _ ps ->
Path innerFocus.id (n :: ps)
, innerTree = focus
, crumbs =
{ id = innerFocus.id
, datum = innerFocus.datum
, before = before
, after = after
}
:: zipper.crumbs
}
)
goUp : Zipper a -> Maybe (Zipper a)
goUp (Zipper zipper) =
case zipper.crumbs of
{ id, datum, before, after } :: bs ->
Just
(Zipper
{ nextId = zipper.nextId
, currentPath =
case zipper.currentPath of
Path _ (_ :: ps) ->
Path id ps
_ ->
-- This branch should never happen.
Path -1 []
, innerTree =
InnerTree
{ id = id
, datum = datum
, children = (before ++ [ zipper.innerTree ] ++ after)
}
, crumbs = bs
}
)
[] ->
Nothing
goLeft : Zipper a -> Maybe (Zipper a)
goLeft (Zipper zipper) =
case zipper.crumbs of
{ id, datum, before, after } :: bs ->
case List.reverse before of
[] ->
Nothing
(InnerTree inner) :: rest ->
Just
(Zipper
{ nextId = zipper.nextId
, currentPath =
case zipper.currentPath of
Path _ (p :: ps) ->
Path inner.id (p - 1 :: ps)
_ ->
-- This branch should never happen.
Path -1 []
, innerTree = InnerTree inner
, crumbs =
{ id = id
, datum = datum
, before = List.reverse rest
, after = zipper.innerTree :: after
}
:: bs
}
)
[] ->
Nothing
goRight : Zipper a -> Maybe (Zipper a)
goRight (Zipper zipper) =
case zipper.crumbs of
{ id, datum, before, after } :: bs ->
case after of
[] ->
Nothing
(InnerTree inner) :: rest ->
Just
(Zipper
{ nextId = zipper.nextId
, currentPath =
case zipper.currentPath of
Path _ (p :: ps) ->
Path inner.id (p + 1 :: ps)
_ ->
-- This branch should never happen.
Path -1 []
, innerTree = InnerTree inner
, crumbs =
{ id = id
, datum = datum
, before = before ++ [ zipper.innerTree ]
, after = rest
}
:: bs
}
)
[] ->
Nothing
-- goToNext : Zipper a -> Maybe (Zipper a)
-- goToPrevious : Zipper a -> Maybe (Zipper a)
goToRightMostChild : Zipper a -> Maybe (Zipper a)
goToRightMostChild (Zipper zipper) =
let
(InnerTree inner) =
zipper.innerTree
in
goToChild ((List.length inner.children) - 1) (Zipper zipper)
-- goTo : (a -> Bool) -> Zipper a -> Maybe (Zipper a)
datum : Zipper a -> a
datum (Zipper zipper) =
let
(InnerTree inner) =
zipper.innerTree
in
inner.datum
updateFocusDatum : (a -> a) -> Zipper a -> Zipper a
updateFocusDatum fn (Zipper zipper) =
let
(InnerTree inner) =
zipper.innerTree
in
Zipper
{ zipper
| innerTree = InnerTree { inner | datum = (fn inner.datum) }
}
-- insertChild : a -> Zipper a -> Zipper a
-- appendChild : a -> Zipper a -> Zipper a
getPath : Zipper a -> Path
getPath (Zipper zipper) =
zipper.currentPath
-- Path operations
{- The Path and Tree can be recombined to recover a previous position in the tree.
walkPath : Path -> Tree a -> Maybe (Zipper a)
Every node will be marked with a unique id, so that re-walking the tree from a Path
can be confirmed as correct. Walking a Path will produce a Maybe.
This allows events to be tagged with Paths which describe a return to a
previously visited position within a tree, without capturing any other data
associated with that node. This is to circumvent the stale data issue when
a user is interacting with a tree.
-}
-- goToPath : Path -> Tree a -> Maybe (Zipper a)
{- The contents of nodes in the tree will be held in an `Array Id a`. Ids will be assigned
sequentially. This will allow mapping by id without re-walking a Path possible. It will
only be necessary to re-walk paths when adding new nodes into the tree, as this is the only
situation when fresh ids will need to be generated.
-}
-- updateDatum : Path -> (a -> a) -> Tree a -> Tree a
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment