Using a Tree Zipper to reflect a tree drag and drop update

I thought I'd share two interesting approaches that I implemented to update a Tree data structure to reflect a drag and drop operation on a heirarchical navigation tree.

In my current web application project, I have a basic navigation tree, where a user can add and delete items from the tree and drag and drop a subtree from one location to another within the tree. The tree component that displays in the browser is a jQuery Javascript plugin. When someone drags and drops a tree item in the browser, an AJAX call sends to the server the source item ID (the item being dragged), the target item ID (the dragged-to item), and the type of the move (before, after, or inside). The type of the move naturally refers to the proximity of the dropped source to the target.

On the server, the Haskell fastCGI program represents the navigation tree data as a multi-way rose tree (import Data.Tree). I needed a way to transform the tree data to reflect the drag and drop update request. Below, was my first attempt to do this, given the source and target ID's, and the type of drop in reference to the target. My strategy was to find the source subtree (getSrc) and place it into a new tree that had the source subtree pruned from its original location. (exSrc). The putAbove, putBelow, and putInside functions do the work of grafting the source subtree into the proper place in relation to the target subtree.

type ProjectTree = Tree Integer

modTree :: Integer -> Integer -> String -> ProjectTree -> ProjectTree
modTree source target typ rs =
    case typ of
        "before" -> head $ b putAbove
        "inside" -> c putInside
        "after" -> head $ b putBelow
      where
        b proc = proc (fromJust (getSrc source rs)) (fromJust (exSrc source rs))
        c proc = proc (fromJust (getSrc source rs)) (fromJust (exSrc source rs))
        putAbove sub rs@(Node a b) =
            if target == a
            then sub:rs:[]
            else [Node a $ concat $ map (putAbove sub) b]
        putBelow sub rs@(Node a b) =
            if target == a
            then rs:sub:[]
            else [Node a $ concat $ map (putBelow sub) b]
        putInside sub rs@(Node a b) =
            if target == a
            then Node a $ concat [b, [sub]]
            else Node a $ map (putInside sub) b

-- Return the tree without the source subtree
exSrc src (Node a b) = 
    if src == a 
    then Nothing 
    else Just $ Node a $ mapMaybe (exSrc src) b

-- Return the source subtree
getSrc src rs@(Node a b) =
    if src == a
    then Just rs
    else case b of
            [] -> Nothing
            _ -> case mapMaybe (getSrc src) b of
                    [] -> Nothing
                    [item] -> Just item

I then decided to use a Tree Zipper (Data.Tree.Zipper) and see if I could come up with a clearer solution. A Zipper is a functional cursor into a data structure, in this case a Tree, and allows directional movement, along with any kind of modification within the tree. This solution was much shorter and arguably clearer and more direct as well.

modTree2 :: Integer -> Integer -> String -> ProjectTree -> ProjectTree
modTree2 source target typ rs =
    case typ of
        "before" -> act insertLeft
        "after" -> act insertRight
        "inside" -> act insertDownLast
  where
    act proc =
        let loc = findNode source $ fromTree rs
        in toTree $ proc (tree loc) (findNode target $ root $ fromJust $ delete loc)
    findNode topic loc =
        fromJust $ find (\n -> topic == getLabel n) $ getSubtrees $ Just loc
    getSubtrees =
        maybe [] (\n -> [n] ++ (getSubtrees $ firstChild n) ++ 
                                 (getSubtrees $ right n))

The fromTree and toTree functions bring the Tree structure in and out of the zipper. The main computation simply finds the source and target subtrees by walking the tree stucture down using the zipper and inserts the souce subtree into the new tree relative to the target. The general expression is embodied in the 2 lines of code that make up the 'act' function.

I'm pretty sure that these two approaches could be somewhat improved on, especially for the first one. I'm curious if anyone has a more direct approach for functionally moving subtrees around.