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

readme.md

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.

Tree.elm

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