diff --git a/demo/Main.hs b/demo/Main.hs
--- a/demo/Main.hs
+++ b/demo/Main.hs
@@ -7,6 +7,7 @@
 ) where
 
 import Data.StableTree
+import Data.StableTree.Persist
 
 import qualified Data.Map as Map
 import Control.Monad              ( foldM )
diff --git a/src/Data/StableTree.hs b/src/Data/StableTree.hs
--- a/src/Data/StableTree.hs
+++ b/src/Data/StableTree.hs
@@ -3,76 +3,38 @@
 -- Copyright : Jeremy Groven
 -- License   : BSD3
 --
--- A Rose Tree designed for maximal stability under mutation. The StableTree
--- structure is meant to be used in places where different versions of a
--- key/value map are kept, such as in a versioning file system or a revision
--- control system. As a tree's contents are mutated (inserted, updated,
--- deleted), it will tend to keep the vast majority of its branches untouched,
--- with generally just the immediate branch and its immediate ancestor chain
--- being modified. Put another way, trees with similar contents will also share
--- a majority of their branches.
+-- A B-Tree variation designed for maximal stability under mutation. The
+-- StableTree structure is meant to be used in places where different versions
+-- of a key/value map are kept, such as in a versioning file system or a
+-- revision control system. As a tree's contents are mutated (inserted,
+-- updated, deleted), it will tend to keep the vast majority of its branches
+-- untouched, with generally just the lowest branch and its immediate ancestor
+-- chain being modified. Put another way, trees with similar contents will also
+-- share a majority of their internal branches.
 --
--- This module exports the public interface for StableTree. Right now, that's
--- just a translation to the standard Data.Map and back. There's nothing about
--- StableTree that forbids direct manipulation, but I've been playing with
--- various implementations of this for way too long, and I just want to start
--- using the dang thing now.
+-- This module exports the public interface for StableTree. It largely mimics
+-- the Data.Map interface, so it should be fairly familiar to Haskell users.
 module Data.StableTree
-( StableTree(..)
+( StableTree
 , fromMap
+, empty
+, insert
+, delete
+, size
+, lookup
+, keys
+, elems
+, assocs
+, fmap
+, append
+, concat
 , toMap
-, Error(..)
-, load
-, load'
-, store
-, store'
-, Fragment(..)
 ) where
 
-import qualified Data.StableTree.Tree as Tree
-import Data.StableTree.Fragment ( Fragment(..) )
-import Data.StableTree.Persist  ( Error(..), load, load', store, store' )
-import Data.StableTree.Tree     ( StableTree(..) )
-
-import qualified Data.Map as Map
-import Data.Map       ( Map )
-import Data.Maybe     ( isNothing )
-import Data.Serialize ( Serialize )
-
--- | Convert a 'Data.Map.Map' into a 'StableTree'.
-fromMap :: (Ord k, Serialize k, Serialize v) => Map k v -> StableTree k v
-fromMap m = go m Map.empty
-  where
-  go values accum =
-    case Tree.nextBottom values of
-      Left incomplete ->
-        if Map.null accum
-          then StableTree_I incomplete
-          else case Tree.getKey incomplete of
-            Just k  -> buildParents accum (Just (k, incomplete)) Map.empty
-            Nothing -> buildParents accum Nothing Map.empty
-      Right (complete, remain) ->
-        if Map.null remain && Map.null accum
-          then StableTree_C complete
-          else go remain $ Map.insert (Tree.completeKey complete) complete accum
-
-  buildParents completes mIncomplete accum =
-    case Tree.nextBranch completes mIncomplete of
-      Left incomplete ->
-        if Map.null accum
-          then StableTree_I incomplete
-          else case Tree.getKey incomplete of
-            Just k  -> buildParents accum (Just (k, incomplete)) Map.empty
-            Nothing -> buildParents accum Nothing Map.empty
-      Right (complete, remain) ->
-        if Map.null remain && Map.null accum && isNothing mIncomplete
-          then StableTree_C complete
-          else 
-            let accum' = Map.insert (Tree.completeKey complete) complete accum
-            in buildParents remain mIncomplete accum'
+import Data.StableTree.Build      ( fromMap, empty, append, concat )
+import Data.StableTree.Mutate     ( insert, delete, fmap )
+import Data.StableTree.Properties ( toMap, size, lookup, keys, elems, assocs )
+import Data.StableTree.Types      ( StableTree )
 
--- | Convert a 'StableTree' back into a 'Data.Map.Map'
-toMap :: Ord k => StableTree k v -> Map k v
-toMap (StableTree_I t) = Tree.treeContents t
-toMap (StableTree_C t) = Tree.treeContents t
+import Prelude ()
 
diff --git a/src/Data/StableTree/Build.hs b/src/Data/StableTree/Build.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Build.hs
@@ -0,0 +1,447 @@
+{-# LANGUAGE LambdaCase, OverloadedStrings, GADTs, ExistentialQuantification #-}
+-- |
+-- Module    : Data.StableTree.Build
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- This is the core implementation of the stable tree. The primary functions
+-- exported by this module are 'nextBottom' and 'nextBranch', which gather
+-- values or lower-level 'Tree's into 'Tree's of the next level.
+--
+-- This module is fairly esoteric. "Data.StableTree" is probably what you
+-- actually want to be using.
+module Data.StableTree.Build
+( fromMap
+, empty
+, append
+, concat
+, consume
+, consumeMap
+, consumeBranches
+, consumeBranches'
+, nextBottom
+, NextBranch(..)
+, nextBranch
+, merge
+) where
+
+import qualified Data.StableTree.Key as Key
+import qualified Data.StableTree.Properties as Properties
+import Data.StableTree.Key   ( SomeKey(..), fromKey, unwrap )
+import Data.StableTree.Types
+
+import qualified Data.Map as Map
+import Control.Arrow  ( first, second )
+import Data.Map       ( Map )
+import Data.Maybe     ( maybeToList )
+import Data.List      ( sortBy )
+import Data.Ord       ( comparing )
+import Data.Serialize ( Serialize )
+
+import Prelude hiding ( concat )
+
+-- |Convert a simple key/value map into a StableTree
+fromMap :: (Ord k, Serialize k, Serialize v) => Map k v -> StableTree k v
+fromMap = (uncurry consume) . consumeMap
+
+-- |Create a new empty StableTree
+empty :: (Ord k, Serialize k, Serialize v) => StableTree k v
+empty = case consumeMap Map.empty of
+          ([], Just inc) -> StableTree_I inc
+          ([complete], Nothing) -> StableTree_C complete
+          _ -> error "an empty tree _does not_ have more than one item"
+
+-- |Smash two StableTree instances into a single one
+append :: (Ord k, Serialize k, Serialize v)
+       => StableTree k v -> StableTree k v -> StableTree k v
+append l r = concat [l, r]
+
+-- |Smash a whole bunch of StableTree instances into a single one
+concat :: (Ord k, Serialize k, Serialize v)
+       => [StableTree k v] -> StableTree k v
+concat = go [] []
+  where
+  go :: (Ord k, Serialize k, Serialize v)
+     => [Tree Z Complete k v] -> [Tree Z Incomplete k v] -> [StableTree k v]
+     -> StableTree k v
+  go completes incompletes [] = concat' completes incompletes
+  go cs is (StableTree_C c:rest) =
+    case c of
+      Bottom _ _ _ _ _   -> go (c:cs) is rest
+      Branch _ _ _ _ _ _ -> branch c cs is rest
+  go cs is (StableTree_I i:rest) =
+    case i of
+      IBottom0 _ _         -> go cs (i:is) rest
+      IBottom1 _ _ _ _     -> go cs (i:is) rest
+      IBranch0 _ _ _       -> branch i cs is rest
+      IBranch1 _ _ _ _     -> branch i cs is rest
+      IBranch2 _ _ _ _ _ _ -> branch i cs is rest
+
+  branch :: (Ord k, Serialize k, Serialize v)
+         => Tree (S d) c k v
+         -> [Tree Z Complete k v]
+         -> [Tree Z Incomplete k v]
+         -> [StableTree k v]
+         -> StableTree k v
+  branch i cs is rest =
+    let (children, minc) = Properties.branchChildren i
+        child'           = map (StableTree_C . snd) $ Map.elems children
+        inc'             = map (\(_, _, t) -> StableTree_I t)
+                               (maybeToList minc)
+    in go cs is (inc' ++ child' ++ rest)
+
+-- |Helper function to convert a complete bunch of Tree instances (of the same
+-- depth) into a single StableTree.
+consume :: (Ord k, Serialize k, Serialize v)
+        => [Tree d Complete k v]
+        -> Maybe (Tree d Incomplete k v)
+        -> StableTree k v
+consume [] Nothing = empty
+consume [c] Nothing = prune $ StableTree_C c
+consume [] (Just i) = prune $ StableTree_I i
+consume cs minc =
+  (uncurry consume) (consumeBranches' cs minc)
+
+-- |Helper function to reduce trees to their minimum height by removing root
+-- branches that only have one child.
+prune :: Ord k => StableTree k v -> StableTree k v
+prune st =
+  case Properties.stableChildren st of
+    Left _ -> st
+    Right m ->
+      -- This may be too wasteful; we'll find out.
+      case Map.elems m of
+        [(_,c)] -> prune c
+        _ -> st
+
+-- |Convert a single key/value map into Tree bottom (zero-depth) instances. The
+-- resulting list of Tree instances will never be overlapping, and will be
+-- sorted such that each Tree's highest key is lower than the next Tree's
+-- lowest key. This is not guaranteed by types because i don't think that can
+-- be done in Haskell.
+consumeMap :: (Ord k, Serialize k, Serialize v)
+           => Map k v
+           -> ([Tree Z Complete k v], Maybe (Tree Z Incomplete k v))
+consumeMap = go []
+  where
+  go accum remain =
+    case nextBottom remain of
+      Left inc ->
+        (reverse accum, Just inc)
+      Right (comp, remain') ->
+        if Map.null remain'
+          then (reverse (comp:accum), Nothing)
+          else go (comp:accum) remain'
+
+-- |Given a mapping from each Tree's first key to that Tree, (and a final
+-- incomplete Tree if desired), this will build the next level of Tree
+-- instances. As with consumeMap, the resulting list of Tree instances will be
+-- non-overlapping and ordered such that each Tree's highest key is smaller
+-- than the next Tree's lowest key.
+consumeBranches :: (Ord k, Serialize k, Serialize v)
+                => Map k (Tree d Complete k v)
+                -> Maybe (k, Tree d Incomplete k v)
+                -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
+consumeBranches = go []
+  where
+  go accum remain minc =
+    case nextBranch remain minc of
+      Empty ->
+        (reverse accum, Nothing) -- I think accum is probably [] here...
+      Final inc ->
+        (reverse accum, Just inc)
+      More comp remain' ->
+        go (comp:accum) remain' minc
+
+-- |Given a simple listing of complete Trees and maybe an incomplete one, this
+-- will build the next level ot Trees. This just builds a map and calls the
+-- previous 'consumeBranches' function, but it's a convenient function to have.
+consumeBranches' :: (Ord k, Serialize k, Serialize v)
+                 => [Tree d Complete k v]
+                 -> Maybe (Tree d Incomplete k v)
+                 -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
+consumeBranches' completes mincomplete =
+  let ctree = Map.fromList [(Properties.completeKey c, c) | c <- completes]
+      mpair = case mincomplete of
+                Nothing -> Nothing
+                Just inc ->
+                  case Properties.getKey inc of
+                    Nothing -> Nothing
+                    Just k -> Just (k, inc)
+  in consumeBranches ctree mpair
+
+-- |Wrap up some of a k/v map into a 'Tree'. A 'Right' result gives a complete
+-- tree and the map updated to not have the key/values that went into that
+-- tree. A 'Left' result gives an incomplete tree that contains everything that
+-- the given map contained.
+nextBottom :: (Ord k, Serialize k, Serialize v)
+           => Map k v
+           -> Either (Tree Z Incomplete k v)
+                     (Tree Z Complete k v, Map k v)
+nextBottom values =
+  case Map.minViewWithKey values >>= return . second Map.minViewWithKey of
+    Just (f1, Just (f2, remain)) ->
+      go (first Key.wrap f1) (first Key.wrap f2) Map.empty remain
+    partial ->
+      -- this is a bit odd, because I couldn't come up with a better way to tie
+      -- the type of the Nothing to the type of the Just, so that
+      -- iBottom0ObjectID would be satisfied.
+      let m = case partial of
+                Nothing -> Nothing
+                Just ((k,v), Nothing) -> Just (Key.wrap k, v)
+                _ ->
+                  error "This is just here to satisfy a broken exhaustion check"
+          b = mkIBottom0 m
+      in Left b
+
+  where
+  go f1 f2 accum remain =
+    case Map.minViewWithKey remain of
+      Nothing ->
+        Left $ mkIBottom1 f1 f2 accum
+      Just ((k, v), remain') ->
+        case Key.wrap k of
+          SomeKey_N nonterm ->
+            go f1 f2 (Map.insert nonterm v accum) remain'
+          SomeKey_T term ->
+            Right (mkBottom f1 f2 accum (term, v), remain')
+
+-- | Result of the 'nextBranch' function; values are described below.
+data NextBranch d k v
+  = Empty
+  | Final (Tree (S d) Incomplete k v)
+  | More  (Tree (S d) Complete k v) (Map k (Tree d Complete k v))
+
+-- |Generate a parent for a k/Tree map. An 'Empty' result means that the
+-- function was called with an empty Map and 'Nothing' for an incomplete. A
+-- 'Final' result means that an incomplete Tree was build and there is no more
+-- work to be done. A 'More' result means that a complete Tree was built, and
+-- there is (possibly) more work to do.
+nextBranch :: (Ord k, Serialize k, Serialize v)
+           => Map k (Tree d Complete k v)
+           -> Maybe (k, Tree d Incomplete k v)
+           -> NextBranch d k v
+nextBranch branches mIncomplete =
+  let freebies = Map.minViewWithKey branches
+                 >>= return . second Map.minViewWithKey
+  in case freebies of
+    Nothing -> 
+      case mIncomplete of
+        Nothing ->
+          Empty
+        Just (ik, iv) ->
+          let tup = (Key.wrap ik, getValueCount iv, iv)
+              b   = mkIBranch0 depth tup
+          in Final b
+    Just ((k,v), Nothing) ->
+      let tup = (Key.wrap k, getValueCount v, v)
+          may = wrapMKey mIncomplete
+      in Final $ mkIBranch1 depth tup may
+    Just (f1, Just (f2, remain)) ->
+      go (wrapKey f1) (wrapKey f2) Map.empty remain
+
+  where
+  go f1 f2 accum remain =
+    let popd = Map.minViewWithKey remain >>= return . first wrapKey
+    in case popd of
+      Nothing ->
+        let may = wrapMKey mIncomplete
+        in Final $ mkIBranch2 depth f1 f2 accum may 
+      Just ((SomeKey_T term,c,v), remain') ->
+        let tup = (term, c, v)
+        in More (mkBranch depth f1 f2 accum tup) remain'
+      Just ((SomeKey_N nonterm,c,v), remain') ->
+        go f1 f2 (Map.insert nonterm (c,v) accum) remain'
+
+  wrapKey (k,v) = (Key.wrap k, getValueCount v, v)
+
+  wrapMKey = (>>=return . wrapKey)
+
+  depth = case Map.elems branches of
+    [] ->
+      case mIncomplete of
+        Nothing -> 1
+        Just (_, v) -> 1 + getDepth v
+    elems ->
+      let depths@(f:r) = map getDepth elems
+          (best, rest) = case mIncomplete of
+                          Nothing -> (f, r)
+                          Just (_, v) -> (getDepth v, depths)
+      in if all (==best) rest
+        then 1 + best
+        else error "Depth mismatch in nextBranch"
+
+-- |Tree mutation functions (insert, delete) will generally wind up with a
+-- bunch of Trees that come before the key that was to be changed, and then the
+-- result of updating the relevant Tree, and then a bunch of Trees (and maybe
+-- an incomplete Tree) that come after it. Merge can splice this result back
+-- into a correctly ordered, non-overlapping list of complete Trees and maybe a
+-- final incomplete one.
+merge :: (Ord k, Serialize k, Serialize v)
+      => [Tree d Complete k v]
+      -> Maybe (Tree d Incomplete k v)
+      -> [Tree d Complete k v]
+      -> Maybe (Tree d Incomplete k v)
+      -> ([Tree d Complete k v], Maybe (Tree d Incomplete k v))
+merge before Nothing after minc =
+  (before ++ after, minc)
+merge before minc [] Nothing =
+  (before, minc)
+merge before (Just left) [] (Just right) =
+  case left of
+    (IBottom0 _ _)         -> bottom before left right
+    (IBottom1 _ _ _ _)     -> bottom before left right
+    (IBranch0 _ _ _)       -> branch before left right
+    (IBranch1 _ _ _ _)     -> branch before left right
+    (IBranch2 _ _ _ _ _ _) -> branch before left right
+
+  where
+  bottom b l r =
+    let lc            = Properties.bottomChildren l
+        rc            = Properties.bottomChildren r
+        (after, minc) = consumeMap (Map.union lc rc)
+    in (b ++ after, minc)
+
+  branch :: (Ord k, Serialize k, Serialize v)
+           => [Tree (S d) Complete k v]
+           -> Tree (S d) Incomplete k v
+           -> Tree (S d) Incomplete k v
+           -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
+  branch b l r =
+    let (c1, i1)      = Properties.branchChildren l
+        c1'           = map snd $ Map.elems c1
+        i1'           = fmap (\(_,_,x) -> x) i1
+        (c2, i2)      = Properties.branchChildren r
+        c2'           = map snd $ Map.elems c2
+        i2'           = fmap (\(_,_,x) -> x) i2
+        (lcomp, linc) = merge c1' i1' c2' i2'
+        lcomp'        = Map.fromList [(Properties.completeKey i,i)|i<-lcomp]
+        linc'         = case linc of
+                          Nothing -> Nothing
+                          Just i ->
+                            case Properties.getKey i of
+                              Nothing -> Nothing
+                              Just k  -> Just (k,i)
+        (after, minc) = consumeBranches lcomp' linc'
+    in (b ++ after, minc)
+
+merge before (Just inc) (after:rest) minc =
+  case inc of
+    (IBottom0 _ _) -> bottom before inc after rest minc
+    (IBottom1 _ _ _ _) -> bottom before inc after rest minc
+    (IBranch0 _ _ _) -> branch before inc after rest minc
+    (IBranch1 _ _ _ _) -> branch before inc after rest minc
+    (IBranch2 _ _ _ _ _ _) -> branch before inc after rest minc
+  where
+  bottom :: (Ord k, Serialize k, Serialize v)
+           => [Tree Z Complete k v]
+           -> Tree Z Incomplete k v
+           -> Tree Z Complete k v
+           -> [Tree Z Complete k v]
+           -> Maybe (Tree Z Incomplete k v)
+           -> ([Tree Z Complete k v], Maybe (Tree Z Incomplete k v))
+  bottom b i a r m =
+    let ic = Properties.bottomChildren i
+        ac = Properties.bottomChildren a
+    in case consumeMap (Map.union ic ac) of
+        (comp, Nothing) -> (b++comp++r, m)
+        (comp, justinc) -> merge (b++comp) justinc r m
+
+  branch :: (Ord k, Serialize k, Serialize v)
+           => [Tree (S d) Complete k v]
+           -> Tree (S d) Incomplete k v
+           -> Tree (S d) Complete k v
+           -> [Tree (S d) Complete k v]
+           -> Maybe (Tree (S d) Incomplete k v)
+           -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
+  branch b i a r m =
+    let (ci, ii)             = Properties.branchChildren i
+        ci'                  = map snd $ Map.elems ci
+        ii'                  = fmap (\(_,_,x) -> x) ii
+        (ca, ia)             = Properties.branchChildren a
+        ca'                  = map snd $ Map.elems ca
+        ia'                  = fmap (\(_,_,x) -> x) ia
+        (low_comp, low_minc) = merge ci' ii' ca' ia'
+        lcomp'               = Map.fromList [ (Properties.completeKey lc, lc)
+                                            | lc <- low_comp]
+        linc'                = case low_minc of
+                                 Nothing -> Nothing
+                                 Just low_inc ->
+                                   case Properties.getKey low_inc of
+                                     Nothing -> Nothing
+                                     Just k  -> Just (k,low_inc)
+        (newcomp, newminc)   = consumeBranches lcomp' linc'
+    in merge (b ++ newcomp) newminc r m
+
+concat' :: (Ord k, Serialize k, Serialize v)
+        => [Tree Z Complete k v]
+        -> [Tree Z Incomplete k v]
+        -> StableTree k v
+concat' completes incompletes =
+  let c_triplets = [ (Properties.completeKey c, completeEnd c, Right c)
+                   | c <- completes ]
+      i_triplets = sort' [ (k, e, Left i) | (Just k, Just e, i) <- 
+                           [ (Properties.getKey i, getEnd i, i)
+                           | i <- incompletes ] ]
+      sorted     = sort' $ c_triplets ++ i_triplets
+  in go [] sorted
+
+  where
+  go accum [] =
+    consume accum Nothing
+  go accum [(_, _, Left i)] =
+    consume accum (Just i)
+  go accum (triple:triples) =
+    let (cont, rest) = eatList Map.empty triple triples
+    in case cont of
+        (cs, Nothing) ->
+          go (accum ++ cs) rest
+        (cs, Just incomplete) ->
+          case (Properties.getKey incomplete, getEnd incomplete) of
+            (Just ibegin, Just iend) ->
+              go (accum ++ cs) ((ibegin, iend, Left incomplete):rest)
+            _ ->
+              go (accum ++ cs) rest
+  
+  eatList kvmap (_, _, Left i) [] | Map.null kvmap =
+    (([], Just i), [])
+  eatList kvmap (_, _, Right c) [] | Map.null kvmap =
+    (([c], Nothing), [])
+  eatList kvmap (_, _, x) [] =
+    let cont = case x of
+                Left i -> Properties.bottomChildren i
+                Right c -> Properties.bottomChildren c
+        both = Map.union kvmap cont
+    in ( consumeMap both, [] )
+  eatList kvmap (_, lhi, Right c) rest@((rlow, _, _):_) | Map.null kvmap && lhi < rlow =
+    (([c], Nothing), rest)
+  eatList kvmap (_, lhi, Right c) rest@((rlow, _, _):_) | lhi < rlow =
+    let cont = Properties.bottomChildren c
+        both = Map.union kvmap cont
+        nxt  = consumeMap both
+    in ( nxt, rest )
+  eatList kvmap (_, _, x) (nxt:rest) =
+    let cont = case x of
+                Left l  -> Properties.bottomChildren l
+                Right r -> Properties.bottomChildren r
+        both = Map.union kvmap cont
+    in eatList both nxt rest
+
+  sort' = sortBy (comparing (\(a,b,_) -> (a,b)))
+
+  completeEnd :: Tree Z Complete k v -> k
+  completeEnd (Bottom _ _ _ _ (tk, _tv)) = fromKey tk
+
+  getEnd :: Tree Z Incomplete k v -> Maybe k
+  getEnd (IBottom0 _ Nothing) =
+    Nothing
+  getEnd (IBottom0 _ (Just (sk, _v))) =
+    Just $ unwrap sk
+  getEnd (IBottom1 _ _ (sk, _v) ntmap) =
+    case Map.toDescList ntmap of
+      []       -> Just $ unwrap sk
+      (k,_v):_ -> Just $ fromKey k
+
+  _1 (x, _, _) = x
+  _2 (_, x, _) = x
+  _3 (_, _, x) = x
diff --git a/src/Data/StableTree/Conversion.hs b/src/Data/StableTree/Conversion.hs
--- a/src/Data/StableTree/Conversion.hs
+++ b/src/Data/StableTree/Conversion.hs
@@ -4,90 +4,107 @@
 -- Copyright : Jeremy Groven
 -- License   : BSD3
 --
--- Functions for converting between Tree and Fragment types
+-- Functions for converting between `Tree` and `Fragment` types
 module Data.StableTree.Conversion
 ( toFragments
 , fromFragments
+, fragsToMap
 ) where
 
-import Data.StableTree.Fragment
-import Data.StableTree.Tree
+import Data.StableTree.Properties ( stableChildren )
+import Data.StableTree.Build      ( consume, consumeMap )
+import Data.StableTree.Types
 
 import qualified Data.Map as Map
 import qualified Data.Text as Text
-import Control.Arrow  ( second )
 import Data.Map       ( Map )
 import Data.ObjectID  ( ObjectID )
 import Data.Serialize ( Serialize )
 import Data.Text      ( Text )
 
-toFragments :: Ord k => Tree c k v -> [(ObjectID, Fragment k v)]
+-- |Convert a 'StableTree' 'Tree' into a list of storable 'Fragment's. The
+-- resulting list is guaranteed to be in an order where each 'Fragment' will be
+-- seen after all its children.
+toFragments :: Ord k => StableTree k v -> [(ObjectID, Fragment k v)]
 toFragments tree =
-  case branchContents tree of
-    Right bottom -> [(getObjectID tree, FragmentBottom bottom)]
-    Left ( completes, mIncomplete ) ->
-      let depth    = getDepth tree
-          cont     = Map.map (second getObjectID) completes
-          cont'    = case mIncomplete of
-                       Nothing -> cont
-                       Just (key,c,t) -> Map.insert key (c,getObjectID t) cont
-          this     = FragmentBranch depth cont'
-          below  = concat $ map (toFragments . snd) $ Map.elems completes
-          below' = case mIncomplete of
-                     Nothing -> below
-                     Just (_,_,t) -> below ++ toFragments t
-      in below' ++ [(getObjectID tree, this)]
+  let oid    = getObjectID tree
+      frag   = makeFragment tree
+  in case stableChildren tree of
+    Left _ -> [(oid, frag)]
+    Right children ->
+      let below  = concat $ map (toFragments . snd) $ Map.elems children
+      in below ++ [(oid, frag)]
 
+-- |Recover a 'Tree' from a single 'Fragment' and a map of the fragments as
+-- returned from 'toFragments'. If the fragment set was already stored, it is
+-- the caller's responsibility to load all the child fragments into a map
+-- (probably involving finding children using the fragmentChildren field of the
+-- Fragment type).
 fromFragments :: (Ord k, Serialize k, Serialize v)
               => Map ObjectID (Fragment k v)
               -> Fragment k v
-              -> Either Text (Either (Tree Incomplete k v)
-                                     (Tree Complete k v))
-fromFragments _ (FragmentBottom assocs) =
-  case nextBottom assocs of
-    Left i -> Right $ Left i
-    Right (c, remain)
-      | Map.null remain -> Right $ Right c
-      | otherwise       -> Left "Fragment had leftovers!?"
-fromFragments loaded (FragmentBranch depth children) =
-  case readChildren Map.empty (Map.toAscList children) of
-    Left err -> Left err
-    Right (tmap, minc) ->
-      case nextBranch tmap minc of
-        Left i -> Right $ Left i
-        Right (c, remain)
-          | Map.null remain && getDepth c == depth -> Right $ Right c
-          | otherwise       -> Left "Fragment rebuild failed"
+              -> Either Text (StableTree k v)
+fromFragments loaded top = do
+  (complete, mincomplete) <- fragsToBottoms loaded top
+  return $ consume complete mincomplete
 
+-- |Directly convert a bunch of `Fragment`s and a root fragment into a
+-- `Data.Map.Map` instance. Mostly useful for testing the correctness of the
+-- `fromFragments` function.
+fragsToMap :: Ord k
+           => Map ObjectID (Fragment k v)
+           -> Fragment k v
+           -> Either Text (Map k v)
+fragsToMap loaded = go Map.empty
   where
-  readChildren _ [] = Left "Invalid empty branch"
-  readChildren accum [(key,(cnt,oid))] =
-    case Map.lookup oid loaded of
-      Nothing -> Left $ cannotFind oid
-      Just frag ->
-        case fromFragments loaded frag of
-          Left err                   -> Left err
-          Right (Right c)
-            | getValueCount c == cnt -> Right (Map.insert key c accum, Nothing)
-            | otherwise              -> Left "Value Count Mismatch"
-          Right (Left l)
-            | getValueCount l == cnt -> Right (accum, Just (key, l))
-            | otherwise              -> Left "Value Count Mismatch"
+  go accum (FragmentBottom m) = Right $ Map.union accum m
+  go accum (FragmentBranch _ children) =
+    go' accum $ map snd $ Map.elems children
 
-  readChildren accum ((key,(cnt,oid)):rest) =
-    case Map.lookup oid loaded of
-      Nothing -> Left $ cannotFind oid
-      Just frag ->
-        case fromFragments loaded frag of
-          Left err -> Left err
-          Right (Right c)
-            | getValueCount c == cnt ->
-                readChildren (Map.insert key c accum) rest
-            | otherwise -> Left "Value Count Mismatch"
-          _ -> Left "Got incomplete branch in non-right position"
+  go' accum [] = Right accum
+  go' accum (first:rest) =
+    case Map.lookup first loaded of
+      Nothing -> notFound first
+      Just frag -> do
+        nxt <- go accum frag
+        go' nxt rest
 
+  notFound objectid =
+    Left $ Text.append "Failed to find Fragment with ID "
+                       (Text.pack $ show objectid)
 
-  cannotFind oid =
-    Text.append "Failed to find object with ObjectID "
-                (Text.pack $ show oid)
+-- |Build a list of the 'Tree Z' instances that come from the given 'Fragment'.
+-- The resulting Trees non-overlapping and ordered such that each Tree's
+-- highest key is lower than the next Tree's lowest key, but illegal Fragments
+-- could break that.
+fragsToBottoms :: (Ord k, Serialize k, Serialize v)
+               => Map ObjectID (Fragment k v)
+               -> Fragment k v
+               -> Either Text ( [Tree Z Complete k v]
+                              , Maybe (Tree Z Incomplete k v))
+fragsToBottoms _ (FragmentBottom m) = Right $ consumeMap m
+fragsToBottoms frags top =
+  let content = fragmentChildren top
+      asList  = Map.toAscList content
+      oids    = map (snd.snd) asList
+  in go oids
+  where
+  go []  = Right ([], Nothing)
+  go [oid] =
+    case Map.lookup oid frags of
+      Nothing -> Left "Failed to lookup a fragment"
+      Just frag -> fragsToBottoms frags frag
+  go (oid:oids) =
+    case Map.lookup oid frags of
+      Nothing -> Left "Failed to lookup a fragment"
+      Just frag ->
+        case fragsToBottoms frags frag of
+          Left err -> Left err
+          Right (completes, Nothing) ->
+            case go oids of
+              Left err -> Left err
+              Right (nxtC, nxtE) ->
+                Right (completes ++ nxtC, nxtE)
+          _ ->
+            Left "Got an Incomplete bottom in a non-terminal position"
 
diff --git a/src/Data/StableTree/Fragment.hs b/src/Data/StableTree/Fragment.hs
deleted file mode 100644
--- a/src/Data/StableTree/Fragment.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-{-# LANGUAGE LambdaCase, OverloadedStrings, GADTs #-}
--- |
--- Module    : Data.StableTree.Types
--- Copyright : Jeremy Groven
--- License   : BSD3
---
--- This is the implementation of tree fragments, which are stand-alone chunks
--- of data representing each branch within a 'Data.StableTree.Types.Tree'. This
--- module is also used by the Tree code for generating each branch's
--- 'ObjectID'.
-module Data.StableTree.Fragment
-( Fragment(..)
-) where
-
-import Data.StableTree.Types ( Depth, ValueCount )
-
-import qualified Data.Map as Map
-import Control.Monad      ( replicateM )
-import Data.ObjectID      ( ObjectID )
-import Data.Serialize     ( Serialize(..) )
-import Control.Applicative ( (<$>) )
-import Data.Serialize.Put ( Put, putByteString )
-import Data.Serialize.Get ( Get, getByteString )
-import Data.Map           ( Map )
-
--- |A 'Fragment' is a user-visible part of a tree, i.e. a single node in the
--- tree that can actually be manipulated by a user. This is useful when doing
--- the work of persisting trees.
-data Fragment k v
-  = FragmentBranch
-    { fragmentDepth    :: Depth
-    , fragmentChildren :: Map k (ValueCount, ObjectID)
-    }
-  | FragmentBottom
-    { fragmentMap :: Map k v
-    }
-  deriving( Eq, Ord, Show )
-
-instance (Ord k, Serialize k, Serialize v) => Serialize (Fragment k v) where
-  put (FragmentBranch depth children) = fragPut depth children
-  put (FragmentBottom values)         = fragPut 0 values
-
-  get =
-    getByteString 12 >>= \case
-      "stable-tree\0" -> do
-        get >>= \case
-          0 -> do
-            count <- get
-            children <- Map.fromList <$> replicateM count getPair
-            return $ FragmentBottom children
-          depth -> do
-            count <- get
-            children <- Map.fromList <$> replicateM count getPair
-            return $ FragmentBranch depth children
-      _ -> fail "Not a serialized Fragment"
-    where
-    getPair :: (Serialize k, Serialize v) => Get (k,v)
-    getPair = do
-      k <- get
-      v <- get
-      return (k,v)
-
-fragPut :: (Serialize k, Serialize v) => Depth -> Map k v -> Put
-fragPut depth items = do
-  putByteString "stable-tree\0"
-  put depth
-  put $ Map.size items
-  mapM_ (\(k,v) -> put k >> put v) (Map.toAscList items)
-
diff --git a/src/Data/StableTree/Mutate.hs b/src/Data/StableTree/Mutate.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Mutate.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE LambdaCase, GADTs #-}
+module Data.StableTree.Mutate
+( insert
+, delete
+, fmap
+) where
+
+import Data.StableTree.Types
+import Data.StableTree.Build      ( consume, consumeBranches', consumeMap, merge )
+import Data.StableTree.Properties ( bottomChildren, selectNode )
+
+import qualified Data.Map as Map
+import Data.Map       ( Map )
+import Data.Serialize ( Serialize )
+
+import qualified Prelude
+import Prelude hiding ( fmap )
+
+-- |Insert a key/value into a 'StableTree'. If the key exists, its existing
+-- value is overwritten.
+insert :: (Ord k, Serialize k, Serialize v)
+       => k -> v -> StableTree k v -> StableTree k v
+insert k v (StableTree_C c) = (uncurry consume) $ insert' k v c
+insert k v (StableTree_I i) = (uncurry consume) $ insert' k v i
+
+-- |Remove a key from the 'StableTree'. If the key is not found, the tree is
+-- returned unchanged.
+delete :: (Ord k, Serialize k, Serialize v)
+       => k -> StableTree k v -> StableTree k v
+delete k (StableTree_C c) = (uncurry consume) $ delete' k c
+delete k (StableTree_I i) = (uncurry consume) $ delete' k i
+
+-- |Same as 'insert', but works on a 'Tree', and returns a list of completes
+-- and a maybe incomplete instead of returning something that probably can't be
+-- expressed in Haskell's type system.
+insert' :: (Ord k, Serialize k, Serialize v)
+        => k
+        -> v
+        -> Tree d c k v
+        -> ([Tree d Complete k v], Maybe (Tree d Incomplete k v))
+insert' k v = mutateBottom k $ Map.insert k v
+
+-- |Same as 'delete', but works on a 'Tree', and returns a list of completes
+-- and a maybe incomplete instead of returning something that probably can't be
+-- expressed in Haskell's type system.
+delete' :: (Ord k, Serialize k, Serialize v)
+        => k
+        -> Tree d c k v
+        -> ([Tree d Complete k v], Maybe (Tree d Incomplete k v))
+delete' k = mutateBottom k $ Map.delete k
+
+-- |Find the 'Tree Z' instance that should contain the given key, and call the
+-- given function on its contents. Once that's done, splice the result back
+-- into a new tree, which will probably be really similar to the original, but
+-- have the desired changes applied.
+mutateBottom :: (Ord k, Serialize k, Serialize v)
+             => k
+             -> (Map k v -> Map k v)
+             -> Tree d c k v
+             -> ([Tree d Complete k v], Maybe (Tree d Incomplete k v))
+mutateBottom search_key mut_fn = \case
+    bottom@(Bottom _ _ _ _ _)     -> consumeMap $ mut_fn $ bottomChildren bottom
+    bottom@(IBottom0 _ _)         -> consumeMap $ mut_fn $ bottomChildren bottom
+    bottom@(IBottom1 _ _ _ _)     -> consumeMap $ mut_fn $ bottomChildren bottom
+    branch@(Branch _ _ _ _ _ _)   -> mutate search_key mut_fn branch
+    branch@(IBranch0 _ _ _)       -> mutate search_key mut_fn branch
+    branch@(IBranch1 _ _ _ _)     -> mutate search_key mut_fn branch
+    branch@(IBranch2 _ _ _ _ _ _) -> mutate search_key mut_fn branch
+  where
+
+  mutate :: (Ord k, Serialize k, Serialize v)
+         => k
+         -> (Map k v -> Map k v)
+         -> Tree (S d) c k v
+         -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
+  mutate key fn b =
+    case selectNode key b of
+      (Left (before, incomplete)) ->
+        let (mut_before, mut_minc) = mutateBottom key fn incomplete
+        in consumeBranches' (before++mut_before) mut_minc
+      (Right (before, tree, after, mincomplete)) ->
+        let (mut_before, mut_minc)       = mutateBottom key fn tree
+            (merged_before, merged_minc) = merge (before++mut_before)
+                                           mut_minc
+                                           after
+                                           mincomplete
+        in consumeBranches' merged_before merged_minc
+
+class SerialFunctor f where
+  -- |Same as the 'fmap' instance of 'Functor', but with the restriction that
+  -- the input and output of the mutation function must be 'Serialize'-able.
+  -- Using the real instance would be really cool, but we need that Serialize
+  -- instance.
+  fmap :: (Serialize a, Serialize b) => (a -> b) -> f a -> f b
+
+instance (Ord k, Serialize k) => SerialFunctor (Tree d c k) where
+  fmap fn (Bottom _ (k1, v1) (k2, v2) nonterms (kt, vt)) =
+    mkBottom (k1, fn v1) (k2, fn v2) (Map.map fn nonterms) (kt, fn vt)
+  fmap fn (IBottom0 _ mpair) =
+    mkIBottom0 (Prelude.fmap (\(k,v) -> (k, fn v)) mpair)
+  fmap fn (IBottom1 _ (k1, v1) (k2, v2) nonterms) =
+    mkIBottom1 (k1, fn v1) (k2, fn v2) (Map.map fn nonterms)
+  fmap fn (Branch _ d (k1, c1, t1) (k2, c2, t2) nonterms (kt, ct, tt)) =
+    mkBranch d
+             (k1, c1, fmap fn t1)
+             (k2, c2, fmap fn t2)
+             (Map.map (\(c,t) -> (c, fmap fn t)) nonterms)
+             (kt, ct, fmap fn tt)
+  fmap fn (IBranch0 _ d (k1, c1, t1)) =
+    mkIBranch0 d
+               (k1, c1, fmap fn t1)
+  fmap fn (IBranch1 _ d (k1, c1, t1) mtriple) =
+    mkIBranch1 d
+               (k1, c1, fmap fn t1)
+               (Prelude.fmap (\(k, c, t) -> (k, c, fmap fn t)) mtriple)
+  fmap fn (IBranch2 _ d (k1, c1, t1) (k2, c2, t2) nonterms mtriple) =
+    mkIBranch2 d
+               (k1, c1, fmap fn t1)
+               (k2, c2, fmap fn t2)
+               (Map.map (\(c, t) -> (c, fmap fn t)) nonterms)
+               (Prelude.fmap (\(k, c, t) -> (k, c, fmap fn t)) mtriple)
+
+instance (Ord k, Serialize k) => SerialFunctor (StableTree k) where
+  fmap fn (StableTree_I i) = StableTree_I $ fmap fn i
+  fmap fn (StableTree_C c) = StableTree_C $ fmap fn c
+
diff --git a/src/Data/StableTree/Persist.hs b/src/Data/StableTree/Persist.hs
--- a/src/Data/StableTree/Persist.hs
+++ b/src/Data/StableTree/Persist.hs
@@ -5,22 +5,21 @@
 -- License   : BSD3
 --
 -- Logic for dealing with the actual persistence of Stable Trees. The key
--- exports here are 'Error', 'Store', 'load', and 'store'. A user needs to
--- implement the 'loadTree', 'loadValue', 'storeTree' and 'storeValue' parts of
--- 'Store', and make an appropriate Error type to report storage errors, and
--- then the 'load' and 'store' functions can just do their thing. If necessary,
--- a user can also implement 'Serialize' for custom data types.
+-- exports here are 'Error', 'load', and 'store'. A user needs to make an
+-- appropriate Error type to report storage errors, and then the 'load' and
+-- 'store' functions can just do their thing. If necessary, a user can also
+-- implement 'Serialize' for custom data types.
 module Data.StableTree.Persist
 ( Error(..)
-, load
-, load'
+, Fragment(..)
 , store
 , store'
+, load
+, load'
 ) where
 
 import Data.StableTree.Conversion ( toFragments, fromFragments )
-import Data.StableTree.Fragment   ( Fragment(..) )
-import Data.StableTree.Tree       ( StableTree(..) )
+import Data.StableTree.Types      ( StableTree(..), Fragment(..) )
 
 import qualified Data.Map as Map
 import Data.ObjectID  ( ObjectID )
@@ -47,10 +46,7 @@
       -> a
       -> StableTree k v
       -> m (Either e a)
-store fn a0 tree =
-  case tree of
-    (StableTree_I i) ->  go a0 $ toFragments i
-    (StableTree_C c) ->  go a0 $ toFragments c
+store fn a0 = go a0 . toFragments
   where
   go accum [] = return $ Right accum
   go accum ((fragid, frag):frags) =
@@ -58,6 +54,8 @@
       Left err -> return $ Left err
       Right accum' -> go accum' frags
 
+-- |Alternate store function that acts more like a map than a fold. See 'store'
+-- for details.
 store' :: (Monad m, Error e, Ord k)
        => (ObjectID -> Fragment k v -> m (Maybe e))
        -> StableTree k v
@@ -69,6 +67,9 @@
       Nothing -> return $ Right oid
       Just err -> return $ Left err
 
+-- |Reverse of 'store'. As with 'store', this acts like a fold, but converts an
+-- 'ObjectID' into a tree, rather than storing a tree. This will always build
+-- the tree from the top down.
 load :: (Monad m, Error e, Ord k, Serialize k, Serialize v)
      => (a -> ObjectID -> m (Either e (a, Fragment k v)))
      -> a
@@ -85,10 +86,7 @@
         Just frag ->
           case fromFragments frags frag of
             Left err -> return $ Left (stableTreeError err)
-            Right (Left t) ->
-              return $ Right (accum, StableTree_I t)
-            Right (Right t) ->
-              return $ Right (accum, StableTree_C t)
+            Right t -> return $ Right (accum, t)
 
   where
   recur accum frags [] = return $ Right (accum, frags)
@@ -101,6 +99,7 @@
           oids     = map snd $ Map.elems children
       in recur accum' (Map.insert oid frag frags) (oids ++ rest)
 
+-- |Version of 'load' that acts like a map rather than a fold.
 load' :: (Monad m, Error e, Ord k, Serialize k, Serialize v)
       => (ObjectID -> m (Either e (Fragment k v)))
       -> ObjectID
diff --git a/src/Data/StableTree/Properties.hs b/src/Data/StableTree/Properties.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Properties.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE GADTs #-}
+-- |
+-- Module    : Data.StableTree
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- Various functions for getting interested data about 'StableTree's and
+-- 'Tree's.
+module Data.StableTree.Properties
+( getKey
+, completeKey
+, size
+, lookup
+, keys
+, elems
+, assocs
+, treeContents
+, toMap
+, stableChildren
+, bottomChildren
+, branchChildren
+, selectNode
+) where
+
+import qualified Data.StableTree.Key as Key
+import Data.StableTree.Types
+
+import qualified Data.Map as Map
+import Control.Arrow  ( second )
+import Data.Map       ( Map )
+
+import Prelude hiding ( lookup )
+
+-- |Get the key of the first entry in this branch. If the branch is empty,
+-- returns Nothing.
+getKey :: Tree d c k v -> Maybe k
+getKey (Bottom _ (k,_) _ _ _)       = Just $ Key.unwrap k
+getKey (IBottom0 _ Nothing)         = Nothing
+getKey (IBottom0 _ (Just (k,_)))    = Just $ Key.unwrap k
+getKey (IBottom1 _ (k,_) _ _)       = Just $ Key.unwrap k
+getKey (Branch _ _ (k,_,_) _ _ _)   = Just $ Key.unwrap k
+getKey (IBranch0 _ _ (k,_,_))       = Just $ Key.unwrap k
+getKey (IBranch1 _ _ (k,_,_) _)     = Just $ Key.unwrap k
+getKey (IBranch2 _ _ (k,_,_) _ _ _) = Just $ Key.unwrap k
+
+-- |Get the key of the first entry in this complete branch. This function is
+-- total.
+completeKey :: Tree d Complete k v -> k
+completeKey (Bottom _ (k,_) _ _ _)     = Key.unwrap k
+completeKey (Branch _ _ (k,_,_) _ _ _) = Key.unwrap k
+
+-- |Get the total number of k/v pairs in the tree
+size :: StableTree k v -> ValueCount
+size = getValueCount
+
+-- |Get the value associated with the given key, or Nothing if there is no
+-- value for the key.
+lookup :: Ord k => k -> StableTree k v -> Maybe v
+lookup key tree =
+  case tree of
+    StableTree_I i -> lookup' key i
+    StableTree_C c -> lookup' key c
+  where
+  lookup' :: Ord k => k -> Tree d c k v -> Maybe v
+  lookup' k t =
+    case t of
+      Bottom _ _ _ _ _     -> Map.lookup k $ bottomChildren t
+      IBottom0 _ _         -> Map.lookup k $ bottomChildren t
+      IBottom1 _ _ _ _     -> Map.lookup k $ bottomChildren t
+      Branch _ _ _ _ _ _   -> lookup'' k t
+      IBranch0 _ _ _       -> lookup'' k t
+      IBranch1 _ _ _ _     -> lookup'' k t
+      IBranch2 _ _ _ _ _ _ -> lookup'' k t
+
+  lookup'' :: Ord k => k -> Tree (S d) c k v -> Maybe v
+  lookup'' k t =
+    case selectNode k t of
+      Left (_, inc) -> lookup' k inc
+      Right (_, comp, _, _) -> lookup' k comp
+
+-- |Get the keys in the map
+keys :: Ord k => StableTree k v -> [k]
+keys = map fst . assocs
+
+-- |Get the elements stored in the map
+elems :: Ord k => StableTree k v -> [v]
+elems = map snd . assocs
+
+-- |Get the key/value pairs in the map
+assocs :: Ord k => StableTree k v -> [(k, v)]
+assocs tree =
+  case tree of
+    StableTree_I i -> assocs' i
+    StableTree_C c -> assocs' c
+  where
+  assocs' :: Ord k => Tree d c k v -> [(k, v)]
+  assocs' t =
+    case t of
+      Bottom _ _ _ _ _     -> Map.assocs $ bottomChildren t
+      IBottom0 _ _         -> Map.assocs $ bottomChildren t
+      IBottom1 _ _ _ _     -> Map.assocs $ bottomChildren t
+      Branch _ _ _ _ _ _   -> assocs'' t
+      IBranch0 _ _ _       -> assocs'' t
+      IBranch1 _ _ _ _     -> assocs'' t
+      IBranch2 _ _ _ _ _ _ -> assocs'' t
+
+  assocs'' :: Ord k => Tree (S d) c k v -> [(k, v)]
+  assocs'' t =
+    let (completes, mincomplete) = branchChildren t
+        ckeys = concat [assocs' ct | (_, ct) <- Map.elems completes]
+        ikeys = case mincomplete of
+                  Nothing -> []
+                  Just (_, _, it) -> assocs' it
+    in ckeys ++ ikeys
+
+
+-- |Convert an entire Tree into a k/v map.
+treeContents :: Ord k => Tree d c k v -> Map k v
+treeContents t =
+  case t of
+    (Bottom _ _ _ _ _)     -> bottomChildren t
+    (IBottom0 _ _)         -> bottomChildren t
+    (IBottom1 _ _ _ _)     -> bottomChildren t
+    (Branch _ _ _ _ _ _)   -> recur $ branchChildren t
+    (IBranch0 _ _ _)       -> recur $ branchChildren t
+    (IBranch1 _ _ _ _)     -> recur $ branchChildren t
+    (IBranch2 _ _ _ _ _ _) -> recur $ branchChildren t
+
+  where
+  recur :: Ord k
+        => ( Map k (ValueCount, Tree d Complete k v)
+           , Maybe (k, ValueCount, Tree d Incomplete k v))
+        -> Map k v
+  recur x =
+    case x of
+      ( completes, Nothing) ->
+        Map.unions $ map (treeContents . snd) $ Map.elems completes
+      ( completes, Just (_k, _c, iv)) ->
+        Map.unions $ treeContents iv:map (treeContents . snd) (Map.elems completes)
+
+-- |Convert a 'StableTree' into a normal key/value Map
+toMap :: Ord k => StableTree k v -> Map k v
+toMap (StableTree_I i) = treeContents i
+toMap (StableTree_C c) = treeContents c
+
+-- |Either get the StableTree "children" of a 'StableTree', or get the
+-- key/value map if the tree is already a bottom.
+stableChildren :: Ord k
+               => StableTree k v
+               -> Either (Map k v) (Map k (ValueCount, StableTree k v))
+stableChildren tree =
+  case tree of
+    StableTree_I i -> stableChildren' i
+    StableTree_C c -> stableChildren' c
+  where
+  stableChildren' :: Ord k
+                  => Tree d c k v
+                  -> Either (Map k v) (Map k (ValueCount, StableTree k v))
+  stableChildren' t =
+    case t of
+      (Bottom _ _ _ _ _)     -> Left $ bottomChildren t
+      (IBottom0 _ _)         -> Left $ bottomChildren t
+      (IBottom1 _ _ _ _)     -> Left $ bottomChildren t
+      (Branch _ _ _ _ _ _)   -> Right $ branchChildren' t
+      (IBranch0 _ _ _)       -> Right $ branchChildren' t
+      (IBranch1 _ _ _ _)     -> Right $ branchChildren' t
+      (IBranch2 _ _ _ _ _ _) -> Right $ branchChildren' t
+
+  branchChildren' :: Ord k
+                  => Tree (S d) c k v
+                  -> Map k (ValueCount, StableTree k v)
+  branchChildren' t =
+    let (compMap, minc) = branchChildren t
+        stableMap       = Map.map (second StableTree_C) compMap
+        fullMap         = case minc of
+                            Nothing ->
+                              stableMap
+                            Just (k, c, i) ->
+                              Map.insert k (c, StableTree_I i) stableMap
+    in fullMap
+
+-- |Non-recursive function to simply get the immediate children of the given
+-- branch. This will either give the key/value map of a Bottom, or the key/tree
+-- map of a non-bottom branch.
+bottomChildren :: Ord k
+               => Tree Z c k v
+               -> Map k v
+bottomChildren (Bottom _ (k1,v1) (k2,v2) terms (kt,vt)) =
+  let terms' = Map.mapKeys Key.fromKey terms
+      conts  = Map.insert (Key.unwrap k1) v1
+             $ Map.insert (Key.unwrap k2) v2
+             $ Map.insert (Key.fromKey kt) vt
+             terms'
+  in conts
+bottomChildren (IBottom0 _ Nothing) =
+  Map.empty
+bottomChildren (IBottom0 _ (Just (k,v))) =
+  Map.singleton (Key.unwrap k) v
+bottomChildren (IBottom1 _ (k1,v1) (k2,v2) terms) =
+  let terms' = Map.mapKeys Key.fromKey terms
+      conts  = Map.insert (Key.unwrap k1) v1
+             $ Map.insert (Key.unwrap k2) v2
+             terms'
+  in conts
+
+-- |Get the 'Tree's stored under the given Tree. The Tree type prevents this
+-- function from being called on bottom Trees.
+branchChildren :: Ord k
+               => Tree (S d) c k v
+               -> ( Map k (ValueCount, Tree d Complete k v)
+                  , Maybe (k, ValueCount, Tree d Incomplete k v))
+branchChildren (Branch _ _d (k1,c1,v1) (k2,c2,v2) terms (kt,ct,vt)) =
+  let terms' = Map.mapKeys Key.fromKey terms
+      conts  = Map.insert (Key.unwrap k1) (c1,v1)
+             $ Map.insert (Key.unwrap k2) (c2,v2)
+             $ Map.insert (Key.fromKey kt) (ct,vt)
+             terms'
+  in (conts, Nothing)
+branchChildren (IBranch0 _ _d (ik,ic,iv)) =
+  (Map.empty, Just (Key.unwrap ik, ic, iv))
+branchChildren (IBranch1 _ _d (k1,c1,v1) mIncomplete) =
+  ( Map.singleton (Key.unwrap k1) (c1,v1)
+  , mIncomplete >>= (\(k,c,v) -> return (Key.unwrap k,c,v)))
+branchChildren (IBranch2 _ _d (k1,c1,v1) (k2,c2,v2) terms mIncomplete) =
+  let terms' = Map.mapKeys Key.fromKey terms
+      conts  = Map.insert (Key.unwrap k1) (c1,v1)
+             $ Map.insert (Key.unwrap k2) (c2,v2)
+             terms'
+  in (conts, mIncomplete >>= \(k,c,v) -> return (Key.unwrap k, c, v))
+
+-- |Choose the child node most likely to hold the given key. If this returns
+-- Left, then the chosen node is the Incomplete node. In the Right case, the
+-- sole Complete node is the best node. The Complete nodes in the first slot of
+-- the quad are the nodes that came before the chosen node, while the nodes in
+-- the third slot are the nodes that came after. This is useful for changing a
+-- specific node, and then patching things back together with the
+-- `Data.StableTree.Build.merge` function.
+selectNode :: Ord k
+           => k
+           -> Tree (S d) c k v
+           -> Either ( [Tree d Complete k v], Tree d Incomplete k v )
+                     ( [Tree d Complete k v], Tree d Complete k v
+                     , [Tree d Complete k v], Maybe (Tree d Incomplete k v) )
+selectNode key branch =
+  let (completes, minc)  = branchChildren branch
+      pairs              = Map.toAscList completes
+      minc_t             = Prelude.fmap (\(_, _, t) -> t) minc
+      test               = \(k, _) -> k <= key
+      -- begin_k is every tree whose lowest key is leq to the given key
+      (begin_k, after_k) = span test pairs
+      begin              = [ t | (_, (_, t)) <- begin_k ]
+      after              = [ t | (_, (_, t)) <- after_k ]
+  in case (reverse begin, after, minc) of
+    ([], [], Nothing) ->                  -- empty branch
+      error "this is totally unreachable. branches are _not_ empty"
+    ([], [], Just (_, _, i)) ->           -- only choice is the incomplete
+      Left ([], i)
+    (_, [], Just (k, _, t)) | k <= key -> -- key goes with the incomplete
+      Left (begin, t)
+    ([], t:rest, _) ->                    -- key is before everything
+      Right ([], t, rest, minc_t)
+    (t:rest, _, _) ->                     -- key goes with "t"
+      Right (reverse rest, t, after, minc_t)
+
diff --git a/src/Data/StableTree/Tree.hs b/src/Data/StableTree/Tree.hs
deleted file mode 100644
--- a/src/Data/StableTree/Tree.hs
+++ /dev/null
@@ -1,502 +0,0 @@
-{-# LANGUAGE LambdaCase, OverloadedStrings, GADTs #-}
--- |
--- Module    : Data.StableTree.Tree
--- Copyright : Jeremy Groven
--- License   : BSD3
---
--- This is the core implementation of the stable tree. The primary functions
--- exported by this module are 'nextBottom' and 'nextBranch', which gather
--- values or lower-level 'Tree's into 'Tree's of the next level.
---
--- This module is fairly esoteric. "Data.StableTree" or "Data.StableTree.IO"
--- are probably what you actually want to be using.
-module Data.StableTree.Tree
-( StableTree(..)
-, Tree
-, Complete
-, Incomplete
-, nextBottom
-, nextBranch
-, getKey
-, completeKey
-, treeContents
-, branchContents
-, getObjectID
-, getDepth
-, getValueCount
-) where
-
-import qualified Data.StableTree.Key as Key
-import Data.StableTree.Fragment ( Fragment(..) )
-import Data.StableTree.Key      ( SomeKey(..), Key, Terminal, Nonterminal )
-import Data.StableTree.Types    ( ValueCount, Depth )
-
-import qualified Data.Map as Map
-import Control.Arrow  ( first, second )
-import Data.List      ( intercalate )
-import Data.Map       ( Map )
-import Data.ObjectID  ( ObjectID, calculateSerialize )
-import Data.Serialize ( Serialize )
-
--- | @StableTree@ is the user-visible type that wraps the actual 'Tree'
--- implementation. All the public functions operate on this type.
-data StableTree k v = StableTree_I (Tree Incomplete k v)
-                    | StableTree_C (Tree Complete k v)
-
--- |Used to indicate that a 'Tree' is not complete
-data Incomplete 
-
--- |Used to indicate that a 'Tree' is complete
-data Complete   
-
--- |The actual Rose Tree structure. StableTree is built on one main idea: every
--- 'Key' is either 'Terminal' or 'Nonterminal'. A complete 'Tree' is one whose
--- final element's Key is terminal, and the rest of the Keys are not (exept for
--- two freebies at the beginning to guarantee convergence). A complete tree
--- always has complete children.
---
--- If we don't have enough data to generate a complete tree (i.e. we ran out of
--- elements before hitting a terminal key), then an 'Incomplete' tree is
--- generated. Incomplete trees are always contained by other incomplete trees,
--- and a tree built from only the complete chlidren of an incomplete tree would
--- never itself be complete.
---
--- It is easiest to understand how this structure promotes stability by looking
--- at how trees typically work. The easiest tree to understand is a simple,
--- well balanced, binary tree. In that case, we would have a structure like this:
---
--- @
---       |D|
---   |B|     |F|
--- |A| |C| |E| |G|
--- @
---
--- Now, suppose that we want to delete the data stored in @|A|@. Then, we'll
--- get a new structure that shares nothing in common with the original one:
---
--- @
---       |E|
---   |C|     |G|
--- |B| |D| |F|
--- @
---
--- The entire tree had to be re-written. This structure is clearly unstable
--- under mutation. Making the tree wider doesn't help much if the tree's size
--- is changing. Simple updates to existing keys are handled well by branches
--- with many children, but deleting from or adding to the beginning of the tree
--- will always cause every single branch to change, which is what this
--- structure is trying to avoid.
---
--- Instead, the stable tree branches have variable child counts. A branch is
--- considered full when its highest key is "terminal", which is determined by
--- hashing the key and looking at some bits of the hash. I've found that a
--- target branch size of 16 children works fairly well, so we check to see if
--- the hash has its least-significant four bits set; if that's the case, the
--- key is terminal. A branch gets two free children (meaning it doesn't care
--- about whether the keys are temrinal or not), and then a run of nonterminal
--- keys, and a final, terminal key. Under this scheme, inserting a new entry
--- into a branch will probably mean inserting a nonterminal key, and it will
--- probably be inserted into the run of nonterminal children. If that's the
--- case, no neighbors will be affected, and only the parents will have to
--- change to point to the new branch. Stability is acheived!
-data Tree c k v where
-  Bottom :: ObjectID
-         -> (SomeKey k, v)
-         -> (SomeKey k, v)
-         -> Map (Key Nonterminal k) v
-         -> (Key Terminal k, v)
-         -> Tree Complete k v
-
-  Branch :: ObjectID
-         -> Depth
-         -> (SomeKey k, ValueCount, Tree Complete k v)
-         -> (SomeKey k, ValueCount, Tree Complete k v)
-         -> Map (Key Nonterminal k) (ValueCount, Tree Complete k v)
-         -> (Key Terminal k, ValueCount, Tree Complete k v)
-         -> Tree Complete k v
-
-  -- Either an empty or a singleton tree
-  IBottom0 :: ObjectID
-           -> Maybe (SomeKey k, v)
-           -> Tree Incomplete k v
-
-  -- Any number of items, but not ending with a terminal key
-  IBottom1 :: ObjectID
-           -> (SomeKey k, v)
-           -> (SomeKey k, v)
-           -> Map (Key Nonterminal k) v
-           -> Tree Incomplete k v
-
-  -- A strut to lift an incomplete tree to the next level up
-  IBranch0 :: ObjectID
-           -> Depth
-           -> (SomeKey k, ValueCount, Tree Incomplete k v)
-           -> Tree Incomplete k v
-
-  -- A joining of a single complete and maybe an incomplete
-  IBranch1 :: ObjectID
-           -> Depth
-           -> (SomeKey k, ValueCount, Tree Complete k v)
-           -> Maybe (SomeKey k, ValueCount, Tree Incomplete k v)
-           -> Tree Incomplete k v
-
-  -- A branch that doesn't have a terminal, and that might have an IBranch
-  IBranch2 :: ObjectID
-           -> Depth
-           -> (SomeKey k, ValueCount, Tree Complete k v)
-           -> (SomeKey k, ValueCount, Tree Complete k v)
-           -> Map (Key Nonterminal k) (ValueCount, Tree Complete k v)
-           -> Maybe (SomeKey k, ValueCount, Tree Incomplete k v)
-           -> Tree Incomplete k v
-
--- |Wrap up some of a k/v map into a 'Tree'. A 'Right' result gives a complete
--- tree and the map updated to not have the key/values that went into that
--- tree. A 'Left' result gives an incomplete tree that contains everything that
--- the given map contained.
-nextBottom :: (Ord k, Serialize k, Serialize v)
-           => Map k v
-           -> Either (Tree Incomplete k v)
-                     (Tree Complete k v, Map k v)
-nextBottom values =
-  case Map.minViewWithKey values >>= return . second Map.minViewWithKey of
-    Just (f1, Just (f2, remain)) ->
-      go (first Key.wrap f1) (first Key.wrap f2) Map.empty remain
-    partial ->
-      -- this is a bit odd, because I couldn't come up with a better way to tie
-      -- the type of the Nothing to the type of the Just, so that
-      -- iBottom0ObjectID would be satisfied.
-      let m = case partial of
-                Nothing -> Nothing
-                Just ((k,v), Nothing) -> Just (Key.wrap k, v)
-                _ ->
-                  error "This is just here to satisfy a broken exhaustion check"
-          o = iBottom0ObjectID m
-          b = IBottom0 o m
-      in Left b
-
-  where
-  go f1 f2 accum remain =
-    case Map.minViewWithKey remain of
-      Nothing ->
-        Left $ IBottom1 (iBottom1ObjectID f1 f2 accum) f1 f2 accum
-      Just ((k, v), remain') ->
-        case Key.wrap k of
-          SomeKey_N nonterm ->
-            go f1 f2 (Map.insert nonterm v accum) remain'
-          SomeKey_T term ->
-            let oid = bottomObjectID f1 f2 accum (term, v)
-            in Right (Bottom oid f1 f2 accum (term, v), remain')
-
--- |Generate a parent for a k/Tree map. A 'Right' result gives a complete tree
--- and the map updated to not have the key/trees that went into that tree. A
--- 'Left' result gives an incomplete tree that contains everything that the
--- given map contained.
-nextBranch :: (Ord k, Serialize k, Serialize v)
-           => Map k (Tree Complete k v)
-           -> Maybe (k, Tree Incomplete k v)
-           -> Either (Tree Incomplete k v)
-                     (Tree Complete k v, Map k (Tree Complete k v))
-nextBranch branches mIncomplete =
-  let freebies = Map.minViewWithKey branches
-                 >>= return . second Map.minViewWithKey
-  in case freebies of
-    Nothing -> 
-      case mIncomplete of
-        Nothing ->
-          Left $ IBottom0 (iBottom0ObjectID (nothing branches)) Nothing
-        Just (ik, iv) ->
-          let tup = (Key.wrap ik, getValueCount iv, iv)
-              oid = iBranch0ObjectID depth tup
-          in Left $ IBranch0 oid depth tup
-    Just ((k,v), Nothing) ->
-      let tup = (Key.wrap k, getValueCount v, v)
-          may = wrapMKey mIncomplete
-          oid = iBranch1ObjectID depth tup may
-      in Left $ IBranch1 oid depth tup may
-    Just (f1, Just (f2, remain)) ->
-      go (wrapKey f1) (wrapKey f2) Map.empty remain
-
-  where
-  go f1 f2 accum remain =
-    let popd = Map.minViewWithKey remain >>= return . first wrapKey
-    in case popd of
-      Nothing ->
-        let may = wrapMKey mIncomplete
-            oid = iBranch2ObjectID depth f1 f2 accum may
-        in Left $ IBranch2 oid depth f1 f2 accum may 
-      Just ((SomeKey_T term,c,v), remain') ->
-        let tup = (term, c, v)
-            oid = branchObjectID depth f1 f2 accum tup
-        in Right ( Branch oid depth f1 f2 accum tup, remain' )
-      Just ((SomeKey_N nonterm,c,v), remain') ->
-        go f1 f2 (Map.insert nonterm (c,v) accum) remain'
-
-  wrapKey (k,v) = (Key.wrap k, getValueCount v, v)
-
-  wrapMKey = (>>=return . wrapKey)
-
-  depth = case Map.elems branches of
-    [] ->
-      case mIncomplete of
-        Nothing -> 1
-        Just (_, v) -> 1 + getDepth v
-    elems ->
-      let depths@(f:r) = map getDepth elems
-          (best, rest) = case mIncomplete of
-                          Nothing -> (f, r)
-                          Just (_, v) -> (getDepth v, depths)
-      in if all (==best) rest
-        then 1 + best
-        else error "Depth mismatch in nextBranch"
-
-  nothing :: Map k (Tree Complete k v) -> Maybe (SomeKey k, v)
-  nothing _ = Nothing
-
--- |Get the key of the first entry in this branch. If the branch is empty,
--- returns Nothing.
-getKey :: Tree c k v -> Maybe k
-getKey (Bottom _ (k,_) _ _ _)       = Just $ Key.unwrap k
-getKey (IBottom0 _ Nothing)         = Nothing
-getKey (IBottom0 _ (Just (k,_)))    = Just $ Key.unwrap k
-getKey (IBottom1 _ (k,_) _ _)       = Just $ Key.unwrap k
-getKey (Branch _ _ (k,_,_) _ _ _)   = Just $ Key.unwrap k
-getKey (IBranch0 _ _ (k,_,_))       = Just $ Key.unwrap k
-getKey (IBranch1 _ _ (k,_,_) _)     = Just $ Key.unwrap k
-getKey (IBranch2 _ _ (k,_,_) _ _ _) = Just $ Key.unwrap k
-
--- |Get the key of the fist entry in this complete branch. This function is
--- total.
-completeKey :: Tree Complete k v -> k
-completeKey (Bottom _ (k,_) _ _ _)     = Key.unwrap k
-completeKey (Branch _ _ (k,_,_) _ _ _) = Key.unwrap k
-
--- |Convert an entire Tree into a k/v map.
-treeContents :: Ord k => Tree c k v -> Map k v
-treeContents t =
-  case branchContents t of
-    Left ( completes, Nothing) ->
-      Map.unions $ map (treeContents . snd) $ Map.elems completes
-    Left ( completes, Just (_k, _c, iv)) ->
-      Map.unions $ treeContents iv:map (treeContents . snd) (Map.elems completes)
-    Right x -> x
-
--- |Get the ObjectID of a tree node
-getObjectID :: Tree c k v -> ObjectID
-getObjectID (Bottom o _ _ _ _)     = o
-getObjectID (Branch o _ _ _ _ _)   = o
-getObjectID (IBottom0 o _)         = o
-getObjectID (IBottom1 o _ _ _)     = o
-getObjectID (IBranch0 o _ _)       = o
-getObjectID (IBranch1 o _ _ _)     = o
-getObjectID (IBranch2 o _ _ _ _ _) = o
-
--- |Get the number of levels of branches that live below this one
-getDepth :: Tree c k v -> Depth
-getDepth (Bottom _ _ _ _ _)     = 0
-getDepth (Branch _ d _ _ _ _)   = d
-getDepth (IBottom0 _ _)         = 0
-getDepth (IBottom1 _ _ _ _)     = 0
-getDepth (IBranch0 _ d _)       = d
-getDepth (IBranch1 _ d _ _)     = d
-getDepth (IBranch2 _ d _ _ _ _) = d
-
--- |Get the number of actual values that live below this branch
-getValueCount :: Tree c k v -> ValueCount
-getValueCount (Bottom _ _ _ m _)   = 3 + Map.size m
-getValueCount (IBottom0 _ Nothing) = 0
-getValueCount (IBottom0 _ _)       = 1
-getValueCount (IBottom1 _ _ _ m)   = 2 + Map.size m
-
-getValueCount (Branch _ _ (_,c1,_) (_,c2,_) nterm (_,c3,_)) =
-  c1 + c2 + c3 + sum (map fst $ Map.elems nterm)
-getValueCount (IBranch0 _ _ (_,c,_)) =
-  c
-getValueCount (IBranch1 _ _ (_,c,_) Nothing) =
-  c
-getValueCount (IBranch1 _ _ (_,c1,_) (Just (_,c2,_))) =
-  c1+c2
-getValueCount (IBranch2 _ _ (_,c1,_) (_,c2,_) m i) =
-  c1 + c2 + sum (map fst $ Map.elems m) + maybe 0 (\(_,c3,_)->c3) i
-
--- |Non-recursive function to simply get the immediate children of the given
--- branch. This will either give the key/value map of a Bottom, or the key/tree
--- map of a non-bottom branch.
-branchContents :: Ord k
-               => Tree c k v
-               -> Either ( Map k (ValueCount, Tree Complete k v)
-                         , Maybe (k, ValueCount, Tree Incomplete k v))
-                         ( Map k v )
-branchContents (Bottom _ (k1,v1) (k2,v2) terms (kt,vt)) =
-  let terms' = Map.mapKeys Key.fromKey terms
-      conts  = Map.insert (Key.unwrap k1) v1
-             $ Map.insert (Key.unwrap k2) v2
-             $ Map.insert (Key.fromKey kt) vt
-             terms'
-  in Right conts
-branchContents (Branch _ _d (k1,c1,v1) (k2,c2,v2) terms (kt,ct,vt)) =
-  let terms' = Map.mapKeys Key.fromKey terms
-      conts  = Map.insert (Key.unwrap k1) (c1,v1)
-             $ Map.insert (Key.unwrap k2) (c2,v2)
-             $ Map.insert (Key.fromKey kt) (ct,vt)
-             terms'
-  in Left (conts, Nothing)
-branchContents (IBottom0 _ Nothing) =
-  Right Map.empty
-branchContents (IBottom0 _ (Just (k,v))) =
-  Right $ Map.singleton (Key.unwrap k) v
-branchContents (IBottom1 _ (k1,v1) (k2,v2) terms) =
-  let terms' = Map.mapKeys Key.fromKey terms
-      conts  = Map.insert (Key.unwrap k1) v1
-             $ Map.insert (Key.unwrap k2) v2
-             terms'
-  in Right conts
-branchContents (IBranch0 _ _d (ik,ic,iv)) =
-  Left (Map.empty, Just (Key.unwrap ik, ic, iv))
-branchContents (IBranch1 _ _d (k1,c1,v1) mIncomplete) =
-  Left ( Map.singleton (Key.unwrap k1) (c1,v1)
-       , mIncomplete >>= (\(k,c,v) -> return (Key.unwrap k,c,v)))
-branchContents (IBranch2 _ _d (k1,c1,v1) (k2,c2,v2) terms mIncomplete) =
-  let terms' = Map.mapKeys Key.fromKey terms
-      conts  = Map.insert (Key.unwrap k1) (c1,v1)
-             $ Map.insert (Key.unwrap k2) (c2,v2)
-             terms'
-  in Left (conts, mIncomplete >>= \(k,c,v) -> return (Key.unwrap k, c, v))
-
-instance Eq (Tree c k v) where
-  t1 == t2 = getObjectID t1 == getObjectID t2
-
-instance (Ord k, Show k, Show v) => Show (Tree c k v) where
-  show t@(Bottom _ _ _ _ _)     = branchShow "Bottom" t
-  show t@(Branch _ _ _ _ _ _)   = branchShow "Branch" t
-  show t@(IBottom0 _ _)         = branchShow "IBottom" t
-  show t@(IBottom1 _ _ _ _)     = branchShow "IBottom" t
-  show t@(IBranch0 _ _ _)       = branchShow "IBranch" t
-  show t@(IBranch1 _ _ _ _)     = branchShow "IBranch" t
-  show t@(IBranch2 _ _ _ _ _ _) = branchShow "IBranch" t
-
-branchShow :: (Ord k, Show k, Show v) => String -> Tree c k v -> String
-branchShow header t =
-  case branchContents t of
-    Left (ts, Nothing) ->
-      let strs = [show k ++ " => " ++ show v | (k, v) <- Map.toAscList ts]
-          str  = intercalate ", " strs
-      in header ++ "(" ++ show (getDepth t) ++ ")<" ++ str ++ ">"
-    Left (ts, Just (ik, _ic, iv)) ->
-      let strs = [ show k ++ " => " ++ show v | (k, v) <- Map.toAscList ts
-                 ] ++ [show ik ++ " => " ++ show iv]
-          str  = intercalate ", " strs
-      in header ++ "(" ++ show (getDepth t) ++ ")<" ++ str ++ ">"
-    Right vals ->
-      let strs = [ show k ++ " => " ++ show v | (k, v) <- Map.toAscList vals ]
-          str  = intercalate ", " strs
-      in header ++ "(" ++ show (getDepth t) ++ ")<" ++ str ++ ">"
-
-bottomObjectID :: (Ord k, Serialize k, Serialize v)
-               => (SomeKey k, v)
-               -> (SomeKey k, v)
-               -> Map (Key Nonterminal k) v
-               -> (Key Terminal k, v)
-               -> ObjectID
-bottomObjectID (sk1, v1) (sk2, v2) ntmap (tk3, v3) =
-  let m = Map.insert (Key.unwrap sk1) v1
-        $ Map.insert (Key.unwrap sk2) v2
-        $ Map.insert (Key.fromKey tk3) v3
-        $ Map.mapKeys Key.fromKey ntmap
-  in calculateSerialize $ FragmentBottom m
-
-branchObjectID :: (Ord k, Serialize k, Serialize v)
-               => Depth
-               -> (SomeKey k, ValueCount, Tree Complete k v)
-               -> (SomeKey k, ValueCount, Tree Complete k v)
-               -> Map (Key Nonterminal k) (ValueCount, Tree Complete k v)
-               -> (Key Terminal k, ValueCount, Tree Complete k v)
-               -> ObjectID
-branchObjectID d (sk1, c1, t1) (sk2, c2, t2) ntmap (tk3, c3, t3) =
-  let m = Map.insert (Key.unwrap sk1) (c1,getObjectID t1)
-        $ Map.insert (Key.unwrap sk2) (c2,getObjectID t2)
-        $ Map.insert (Key.fromKey tk3) (c3,getObjectID t3)
-        $ Map.map (second getObjectID)
-        $ Map.mapKeys Key.fromKey ntmap
-      b = FragmentBranch d m
-      _ = witness t1 b
-  in calculateSerialize b
-
-iBottom0ObjectID :: (Ord k, Serialize k, Serialize v)
-                 => Maybe (SomeKey k, v)
-                 -> ObjectID
-iBottom0ObjectID mkv =
-  let m = Map.empty
-      -- This funny dance ties the type of 'm' to the types of 'k' and 'v', so
-      -- our empty fragment bottom can type check
-      f = case mkv of
-            Nothing -> FragmentBottom m
-            Just (sk, v) -> FragmentBottom $ Map.insert (Key.unwrap sk) v m
-  in calculateSerialize f
-
-iBottom1ObjectID :: (Ord k, Serialize k, Serialize v)
-                 => (SomeKey k, v)
-                 -> (SomeKey k, v)
-                 -> Map (Key Nonterminal k) v
-                 -> ObjectID
-iBottom1ObjectID (sk1, v1) (sk2, v2) ntmap =
-  let m = Map.insert (Key.unwrap sk1) v1
-        $ Map.insert (Key.unwrap sk2) v2
-        $ Map.mapKeys Key.fromKey ntmap
-      b = FragmentBottom m
-  in calculateSerialize b
-
-iBranch0ObjectID :: (Ord k, Serialize k, Serialize v)
-                 => Depth
-                 -> (SomeKey k, ValueCount, Tree Incomplete k v)
-                 -> ObjectID
-iBranch0ObjectID d (sk,c,t) =
-  let m = Map.singleton (Key.unwrap sk) (c, getObjectID t)
-      b = FragmentBranch d m
-      _ = witness t b
-  in calculateSerialize b
-
-iBranch1ObjectID :: (Ord k, Serialize k, Serialize v)
-                 => Depth
-                 -> (SomeKey k, ValueCount, Tree Complete k v)
-                 -> Maybe (SomeKey k, ValueCount, Tree Incomplete k v)
-                 -> ObjectID
-iBranch1ObjectID d (sk, c, t) minc =
-  let m = Map.singleton (Key.unwrap sk) (c, getObjectID t)
-      m' = case minc of
-            Nothing -> m
-            Just (sk', c', t') ->
-              Map.insert (Key.unwrap sk') (c', getObjectID t') m
-      b = FragmentBranch d m'
-      _ = witness t b
-  in calculateSerialize b
-
-iBranch2ObjectID :: (Ord k, Serialize k, Serialize v)
-                 => Depth
-                 -> (SomeKey k, ValueCount, Tree Complete k v)
-                 -> (SomeKey k, ValueCount, Tree Complete k v)
-                 -> Map (Key Nonterminal k) (ValueCount, Tree Complete k v)
-                 -> Maybe (SomeKey k, ValueCount, Tree Incomplete k v)
-                 -> ObjectID
-iBranch2ObjectID d (sk1, c1, t1) (sk2, c2, t2) ntmap minc =
-  let m = Map.insert (Key.unwrap sk1) (c1, getObjectID t1)
-        $ Map.insert (Key.unwrap sk2) (c2, getObjectID t2)
-        $ Map.mapKeys Key.fromKey
-        $ Map.map (second getObjectID) ntmap
-      m' = case minc of
-            Nothing -> m
-            Just (sk3, c3, t3) ->
-              Map.insert (Key.unwrap sk3) (c3, getObjectID t3) m
-      b = FragmentBranch d m'
-      _ = witness t1 b
-  in calculateSerialize b
-
--- 'FragmentBranch' doesn't rely at all on the 'v' part of the given trees,
--- as it only maps keys to ObjectIDs. This witness ties the fragment to the
--- tree so the type checker can guarantee the 'Serialize v' instance that
--- allows us to calculate the ObjectID.
-witness :: Tree c k v -> Fragment k v -> ()
-witness _ _ = ()
-
-instance (Ord k, Show k, Show v) => Show (StableTree k v) where
-  show (StableTree_I t) = show t
-  show (StableTree_C t) = show t
diff --git a/src/Data/StableTree/Types.hs b/src/Data/StableTree/Types.hs
--- a/src/Data/StableTree/Types.hs
+++ b/src/Data/StableTree/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase, OverloadedStrings, GADTs, ExistentialQuantification, StandaloneDeriving #-}
 -- |
 -- Module    : Data.StableTree.Types
 -- Copyright : Jeremy Groven
@@ -7,11 +8,406 @@
 module Data.StableTree.Types
 ( Depth
 , ValueCount
+, StableTree(..)
+, Incomplete
+, Complete
+, Z
+, S
+, Tree(..)
+, Fragment(..)
+, mkBottom
+, mkIBottom0
+, mkIBottom1
+, mkBranch
+, mkIBranch0
+, mkIBranch1
+, mkIBranch2
+, getObjectID
+, getDepth
+, getValueCount
+, calcObjectID
+, fixObjectID
+, makeFragment
 ) where
 
+import qualified Data.StableTree.Key as Key
+import Data.StableTree.Key      ( SomeKey(..), Key(..), Terminal, Nonterminal )
+
+import qualified Data.Map as Map
+import Control.Applicative ( (<$>) )
+import Control.Arrow      ( second )
+import Control.Monad      ( replicateM )
+import Data.Serialize     ( Serialize(..) )
+import Data.Serialize.Put ( Put, putByteString )
+import Data.Serialize.Get ( Get, getByteString )
+import Data.ObjectID  ( ObjectID, calculateSerialize )
+import Data.Map       ( Map )
+
 -- |Alias to indicate how deep a branch in a tree is. Bottoms have depth 0
 type Depth = Int
 
 -- |Alias that indicates the total number of values underneath a tree
 type ValueCount = Int
+
+-- | @StableTree@ is the user-visible type that wraps the actual 'Tree'
+-- implementation. All the public functions operate on this type.
+data StableTree k v = forall d. StableTree_I (Tree d Incomplete k v)
+                    | forall d. StableTree_C (Tree d Complete k v)
+
+-- |Used to indicate that a 'Tree' is not complete
+data Incomplete 
+
+-- |Used to indicate that a 'Tree' is complete
+data Complete   
+
+-- |Empty type to indicate a Tree with Zero depth (a bottom node)
+data Z
+
+-- |Empty type to indicate a Tree with some known height (a branch)
+data S a
+
+-- |The actual B-Tree variant. StableTree is built on one main idea: every
+-- 'Key' is either 'Terminal' or 'Nonterminal', and every 'Tree' is 'Complete'
+-- or 'Incomplete'. A complete 'Tree' is one whose final element's Key is
+-- terminal, and the rest of the Keys are not (exept for two freebies at the
+-- beginning to guarantee convergence). A complete tree always has complete
+-- children.
+--
+-- If we don't have enough data to generate a complete tree (i.e. we ran out of
+-- elements before hitting a terminal key), then an 'Incomplete' tree is
+-- generated. Incomplete trees are always contained by other incomplete trees,
+-- and a tree built from only the complete children of an incomplete tree would
+-- never itself be complete.
+--
+-- It is easiest to understand how this structure promotes stability by looking
+-- at how trees typically work. The easiest tree to understand is a simple,
+-- well balanced, binary tree. In that case, we would have a structure like this:
+--
+-- @
+--       |D|
+--   |B|     |F|
+-- |A| |C| |E| |G|
+-- @
+--
+-- Now, suppose that we want to delete the data stored in @|A|@. Then, we'll
+-- get a new structure that shares nothing in common with the original one:
+--
+-- @
+--       |E|
+--   |C|     |G|
+-- |B| |D| |F|
+-- @
+--
+-- The entire tree had to be re-written. This structure is clearly unstable
+-- under mutation. Making the tree wider doesn't help much if the tree's size
+-- is changing. Simple updates to existing keys are handled well by branches
+-- with many children, but deleting from or adding to the beginning of the tree
+-- will always cause every single branch to change, which is what this
+-- structure is trying to avoid.
+--
+-- Instead, the stable tree branches have variable child counts. A branch is
+-- considered full when its highest key is "terminal", which is determined by
+-- hashing the key and looking at some bits of the hash. I've found that a
+-- target branch size of 16 children works fairly well, so we check to see if
+-- the hash has its least-significant four bits set; if that's the case, the
+-- key is terminal. A branch gets two free children (meaning it doesn't care
+-- about whether the keys are terminal or not), and then a run of nonterminal
+-- keys, and a final, terminal key. Under this scheme, inserting a new entry
+-- into a branch will probably mean inserting a nonterminal key, and it will
+-- probably be inserted into the run of nonterminal children. If that's the
+-- case, no neighbors will be affected, and only the parents will have to
+-- change to point to the new branch. Stability is achieved!
+data Tree d c k v where
+  Bottom :: ObjectID
+         -> (SomeKey k, v)
+         -> (SomeKey k, v)
+         -> Map (Key Nonterminal k) v
+         -> (Key Terminal k, v)
+         -> Tree Z Complete k v
+
+  -- Either an empty or a singleton tree
+  IBottom0 :: ObjectID
+           -> Maybe (SomeKey k, v)
+           -> Tree Z Incomplete k v
+
+  -- Any number of items, but not ending with a terminal key
+  IBottom1 :: ObjectID
+           -> (SomeKey k, v)
+           -> (SomeKey k, v)
+           -> Map (Key Nonterminal k) v
+           -> Tree Z Incomplete k v
+
+  Branch :: ObjectID
+         -> Depth
+         -> (SomeKey k, ValueCount, Tree d Complete k v)
+         -> (SomeKey k, ValueCount, Tree d Complete k v)
+         -> Map (Key Nonterminal k) (ValueCount, Tree d Complete k v)
+         -> (Key Terminal k, ValueCount, Tree d Complete k v)
+         -> Tree (S d) Complete k v
+
+  -- A strut to lift an incomplete tree to the next level up
+  IBranch0 :: ObjectID
+           -> Depth
+           -> (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+
+  -- A joining of a single complete and maybe an incomplete
+  IBranch1 :: ObjectID
+           -> Depth
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> Maybe (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+
+  -- A branch that doesn't have a terminal, and that might have an IBranch
+  IBranch2 :: ObjectID
+           -> Depth
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> Map (Key Nonterminal k) (ValueCount, Tree d Complete k v)
+           -> Maybe (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+
+-- |Helper to create a 'Bottom' instance with a calculated ObjectID
+mkBottom :: (Ord k, Serialize k, Serialize v)
+         => (SomeKey k, v) -> (SomeKey k, v) -> Map (Key Nonterminal k) v
+         -> (Key Terminal k, v) -> Tree Z Complete k v
+mkBottom p1 p2 nts t = fixObjectID $ Bottom undefined p1 p2 nts t
+
+-- |Helper to create an 'IBottom0' instance with a calculated ObjectID
+mkIBottom0 :: (Ord k, Serialize k, Serialize v)
+           => Maybe (SomeKey k, v) -> Tree Z Incomplete k v
+mkIBottom0 mp = fixObjectID $ IBottom0 undefined mp
+
+-- |Helper to create an 'IBottom1' instance with a calculated ObjectID
+mkIBottom1 :: (Ord k, Serialize k, Serialize v)
+           => (SomeKey k, v) -> (SomeKey k, v) -> Map (Key Nonterminal k) v
+           -> Tree Z Incomplete k v
+mkIBottom1 p1 p2 nts = fixObjectID $ IBottom1 undefined p1 p2 nts
+
+-- |Helper to create a 'Branch' instance with a calculated ObjectID
+mkBranch :: (Ord k, Serialize k, Serialize v)
+         => Depth
+         -> (SomeKey k, ValueCount, Tree d Complete k v)
+         -> (SomeKey k, ValueCount, Tree d Complete k v)
+         -> Map (Key Nonterminal k) (ValueCount, Tree d Complete k v)
+         -> (Key Terminal k, ValueCount, Tree d Complete k v)
+         -> Tree (S d) Complete k v
+mkBranch d t1 t2 nts t = fixObjectID $ Branch undefined d t1 t2 nts t
+
+-- |Helper to create an 'IBranch0' instance with a calculated ObjectID
+mkIBranch0 :: (Ord k, Serialize k, Serialize v)
+           => Depth
+           -> (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+mkIBranch0 d inc = fixObjectID $ IBranch0 undefined d inc
+
+-- |Helper to create an 'IBranch1' instance with a calculated ObjectID
+mkIBranch1 :: (Ord k, Serialize k, Serialize v)
+           => Depth
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> Maybe (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+mkIBranch1 d tup minc = fixObjectID $ IBranch1 undefined d tup minc
+
+-- |Helper to create an 'IBranch2' instance with a calculated ObjectID
+mkIBranch2 :: (Ord k, Serialize k, Serialize v)
+           => Depth
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> (SomeKey k, ValueCount, Tree d Complete k v)
+           -> Map (Key Nonterminal k) (ValueCount, Tree d Complete k v)
+           -> Maybe (SomeKey k, ValueCount, Tree d Incomplete k v)
+           -> Tree (S d) Incomplete k v
+mkIBranch2  d t1 t2 nts minc = fixObjectID $ IBranch2 undefined d t1 t2 nts minc
+
+-- |A 'Fragment' is a user-visible part of a tree, i.e. a single node in the
+-- tree that can actually be manipulated by a user. This is useful when doing
+-- the work of persisting trees, and its serialize instance is also used to
+-- calculate Tree ObjectIDs. See `Data.StableTree.Conversion.toFragments` and
+-- `Data.StableTree.Conversion.fromFragments` for functions to convert between
+-- Fragments and Trees. see `Data.StableTree.Persist.store` and
+-- `Data.StableTree.Persist.load` for functions related to storing and
+-- retrieving Fragments.
+data Fragment k v
+  = FragmentBranch
+    { fragmentDepth    :: Depth
+    , fragmentChildren :: Map k (ValueCount, ObjectID)
+    }
+  | FragmentBottom
+    { fragmentMap :: Map k v
+    }
+  deriving( Eq, Ord, Show )
+
+class TreeNode n where
+  -- |Get the ObjectID of a 'Tree' or 'StableTree'
+  getObjectID   :: n k v -> ObjectID
+  -- |Get the depth (height?) of a 'Tree' or 'StableTree'
+  getDepth      :: n k v -> Depth
+  -- |Get the total number of key/value pairs stored under this 'Tree' or
+  -- 'StableTree'
+  getValueCount :: n k v -> ValueCount
+  -- |Do the (expensive) calculation of a 'Tree' or 'StableTree'; generally
+  -- used to do the initial ObjectID calculation when constructing an instance
+  calcObjectID  :: (Ord k, Serialize k, Serialize v) => n k v -> ObjectID
+  -- |Recalculate the object's ObjectID and return the updated object;
+  -- pretty much a convenience function around 'calcObjectID'
+  fixObjectID   :: (Ord k, Serialize k, Serialize v) => n k v -> n k v
+  -- |Get the 'Fragment' representing this exact 'Tree' node, used for
+  -- persistent storage
+  makeFragment  :: Ord k => n k v -> Fragment k v
+  -- getFullContents :: n k v -> Map k v
+
+instance TreeNode (Tree d c) where
+  getObjectID (Bottom o _ _ _ _)     = o
+  getObjectID (IBottom0 o _)         = o
+  getObjectID (IBottom1 o _ _ _)     = o
+  getObjectID (Branch o _ _ _ _ _)   = o
+  getObjectID (IBranch0 o _ _)       = o
+  getObjectID (IBranch1 o _ _ _)     = o
+  getObjectID (IBranch2 o _ _ _ _ _) = o
+
+  getDepth (Bottom _ _ _ _ _)     = 0
+  getDepth (IBottom0 _ _)         = 0
+  getDepth (IBottom1 _ _ _ _)     = 0
+  getDepth (Branch _ d _ _ _ _)   = d
+  getDepth (IBranch0 _ d _)       = d
+  getDepth (IBranch1 _ d _ _)     = d
+  getDepth (IBranch2 _ d _ _ _ _) = d
+
+  getValueCount (Bottom _ _ _ m _)   = 3 + Map.size m
+  getValueCount (IBottom0 _ Nothing) = 0
+  getValueCount (IBottom0 _ _)       = 1
+  getValueCount (IBottom1 _ _ _ m)   = 2 + Map.size m
+  
+  getValueCount (Branch _ _ (_,c1,_) (_,c2,_) nterm (_,c3,_)) =
+    c1 + c2 + c3 + sum (map fst $ Map.elems nterm)
+  getValueCount (IBranch0 _ _ (_,c,_)) =
+    c
+  getValueCount (IBranch1 _ _ (_,c,_) Nothing) =
+    c
+  getValueCount (IBranch1 _ _ (_,c1,_) (Just (_,c2,_))) =
+    c1+c2
+  getValueCount (IBranch2 _ _ (_,c1,_) (_,c2,_) m i) =
+    c1 + c2 + sum (map fst $ Map.elems m) + maybe 0 (\(_,c3,_)->c3) i
+
+  calcObjectID tree = calculateSerialize $ makeFragment tree
+
+  fixObjectID t@(Bottom _ a b c d)     = Bottom (calcObjectID t) a b c d
+  fixObjectID t@(IBottom0 _ a)         = IBottom0 (calcObjectID t) a
+  fixObjectID t@(IBottom1 _ a b c)     = IBottom1 (calcObjectID t) a b c
+  fixObjectID t@(Branch _ a b c d e)   = Branch (calcObjectID t) a b c d e
+  fixObjectID t@(IBranch0 _ a b)       = IBranch0 (calcObjectID t) a b
+  fixObjectID t@(IBranch1 _ a b c)     = IBranch1 (calcObjectID t) a b c
+  fixObjectID t@(IBranch2 _ a b c d e) = IBranch2 (calcObjectID t) a b c d e
+
+  makeFragment tree =
+    case tree of
+      (Bottom _ p1 p2 m pt) ->
+        fragBottom p1 p2 m (Just pt)
+      (IBottom0 _ Nothing) ->
+        FragmentBottom Map.empty
+      (IBottom0 _ (Just (k1,v1))) ->
+        FragmentBottom $ Map.singleton (Key.unwrap k1) v1
+      (IBottom1 _ p1 p2 m) ->
+        fragBottom p1 p2 m Nothing
+      (Branch _ d (k1,c1,t1) (k2,c2,t2) m (kt,ct,tt)) ->
+        let cont = Map.insert (Key.unwrap k1) (c1,getObjectID t1)
+                 $ Map.insert (Key.unwrap k2) (c2,getObjectID t2)
+                 $ Map.insert (fromKey kt) (ct,getObjectID tt)
+                 $ Map.mapKeys fromKey
+                 $ Map.map (second getObjectID) m
+        in FragmentBranch d cont
+      (IBranch0 _ d (k,c,t)) ->
+        FragmentBranch d $ Map.singleton (Key.unwrap k) (c,getObjectID t)
+      (IBranch1 _ d (k,c,t) Nothing) ->
+        FragmentBranch d $ Map.singleton (Key.unwrap k) (c,getObjectID t)
+      (IBranch1 _ d (k,c,t) (Just (ki,ci,ti))) ->
+        let cont = Map.fromList [ (Key.unwrap k, (c, getObjectID t))
+                                , (Key.unwrap ki, (ci, getObjectID ti)) ]
+        in FragmentBranch d cont
+      (IBranch2 _ d (k1,c1,t1) (k2,c2,t2) m minc) ->
+        let cont = Map.insert (Key.unwrap k1) (c1,getObjectID t1)
+                 $ Map.insert (Key.unwrap k2) (c2,getObjectID t2)
+                 $ Map.mapKeys fromKey
+                 $ Map.map (second getObjectID) m
+            cont' = case minc of
+              Nothing -> cont
+              (Just (ki,ci,ti)) ->
+                Map.insert (Key.unwrap ki) (ci, getObjectID ti) cont
+        in FragmentBranch d cont'
+    where
+    fragBottom (k1,v1) (k2,v2) mapping mterm =
+      let cont = Map.insert (Key.unwrap k1) v1
+               $ Map.insert (Key.unwrap k2) v2
+               $ Map.mapKeys fromKey mapping
+          cont' = case mterm of
+            Nothing -> cont
+            (Just (tk, tv)) -> Map.insert (fromKey tk) tv cont
+      in FragmentBottom cont'
+
+instance TreeNode StableTree where
+  getObjectID (StableTree_I t) = getObjectID t
+  getObjectID (StableTree_C t) = getObjectID t
+
+  getDepth (StableTree_I t) = getDepth t
+  getDepth (StableTree_C t) = getDepth t
+
+  getValueCount (StableTree_I t) = getValueCount t
+  getValueCount (StableTree_C t) = getValueCount t
+
+  calcObjectID (StableTree_I t) = calcObjectID t
+  calcObjectID (StableTree_C t) = calcObjectID t
+
+  fixObjectID (StableTree_I t) = StableTree_I $ fixObjectID t
+  fixObjectID (StableTree_C t) = StableTree_C $ fixObjectID t
+
+  makeFragment (StableTree_I t) = makeFragment t
+  makeFragment (StableTree_C t) = makeFragment t
+
+instance Eq (Tree d c k v) where
+  t1 == t2 = getObjectID t1 == getObjectID t2
+
+instance Eq (StableTree k v) where
+  (StableTree_I t1) == (StableTree_I t2) = getObjectID t1 == getObjectID t2
+  (StableTree_C t1) == (StableTree_C t2) = getObjectID t1 == getObjectID t2
+  (StableTree_I _) == (StableTree_C _) = False
+  (StableTree_C _) == (StableTree_I _) = False
+
+instance Ord (StableTree k v) where
+  compare l r = compare (getObjectID l) (getObjectID r)
+
+deriving instance (Ord k, Show k, Show v) => Show (StableTree k v)
+deriving instance (Ord k, Show k, Show v) => Show (Tree d c k v)
+
+instance (Ord k, Serialize k, Serialize v) => Serialize (Fragment k v) where
+  put frag =
+    case frag of
+      (FragmentBranch depth children) -> fragPut depth children
+      (FragmentBottom values)         -> fragPut 0 values
+    where
+    fragPut :: (Serialize k, Serialize v) => Depth -> Map k v -> Put
+    fragPut depth items = do
+      putByteString "stable-tree\0"
+      put depth
+      put $ Map.size items
+      mapM_ (\(k,v) -> put k >> put v) (Map.toAscList items)
+
+  get =
+    getByteString 12 >>= \case
+      "stable-tree\0" -> do
+        get >>= \case
+          0 -> do
+            count <- get
+            children <- Map.fromList <$> replicateM count getPair
+            return $ FragmentBottom children
+          depth -> do
+            count <- get
+            children <- Map.fromList <$> replicateM count getPair
+            return $ FragmentBranch depth children
+      _ -> fail "Not a serialized Fragment"
+    where
+    getPair :: (Serialize k, Serialize v) => Get (k,v)
+    getPair = do
+      k <- get
+      v <- get
+      return (k,v)
 
diff --git a/stable-tree.cabal b/stable-tree.cabal
--- a/stable-tree.cabal
+++ b/stable-tree.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                stable-tree
-version:             0.5.0
+version:             0.6.0
 synopsis:            Trees whose branches are resistant to change
 -- description:         
 homepage:            https://github.com/tsuraan/stable-tree
@@ -30,11 +30,12 @@
 
 library
   exposed-modules:     Data.StableTree
-                     , Data.StableTree.Conversion
-                     , Data.StableTree.Fragment
                      , Data.StableTree.Types
+                     , Data.StableTree.Properties
                      , Data.StableTree.Key
-                     , Data.StableTree.Tree
+                     , Data.StableTree.Conversion
+                     , Data.StableTree.Build
+                     , Data.StableTree.Mutate
                      , Data.StableTree.Persist
   -- other-modules:       
   -- other-extensions:    
@@ -68,4 +69,4 @@
                      , tasty-quickcheck
   hs-source-dirs:      tests
   default-language:    Haskell2010
-  ghc-options:         -Wall
+  ghc-options:         -O2 -Wall -threaded
diff --git a/tests/TestAll.hs b/tests/TestAll.hs
--- a/tests/TestAll.hs
+++ b/tests/TestAll.hs
@@ -4,10 +4,14 @@
 ) where
 
 import qualified Data.StableTree as ST
-import Data.StableTree ( Fragment, Error(..) )
+import qualified Data.StableTree.Persist as SP
+import Data.StableTree ( StableTree )
+import Data.StableTree.Persist ( Fragment(..), Error(..) )
 
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import Control.Arrow              ( first )
+import Control.Applicative        ( (<$>) )
 import Control.Monad.State.Strict ( State, runState, modify, gets )
 import Data.ByteString            ( ByteString )
 import Data.ByteString.Arbitrary  ( ArbByteString(..) )
@@ -16,8 +20,13 @@
 import Data.Serialize             ( Serialize, encode, decode )
 import Data.Text                  ( Text )
 import Test.Tasty
-import Test.Tasty.QuickCheck      ( testProperty )
+import Test.Tasty.QuickCheck      ( Arbitrary, testProperty, oneof, arbitrary )
+import Test.QuickCheck            ( Gen, elements )
 
+-- import Debug.Trace ( trace )
+-- trace :: a -> b -> b
+-- trace _ b = b
+
 main :: IO ()
 main = defaultMain $
   testGroup "StableTree"
@@ -34,24 +43,98 @@
   ]
   where
 
-  int_int :: [(Int,Int)] -> Bool
+  int_int :: [(Int,Int)] -> Gen Bool
   int_int pairs =
     let m = Map.fromList pairs
         st = ST.fromMap m
-    in m == ST.toMap st
+    in if m == ST.toMap st && Map.keys m == ST.keys st && Map.elems m == ST.elems st
+      then do
+        and <$> sequence [ test_delete pairs
+                         , return $ test_lookup (Map.toList m) st
+                         , test_insert pairs
+                         , test_mutate st ]
+      else return False
 
-  float_int :: [(Float,Int)] -> Bool
+  float_int :: [(Float,Int)] -> Gen Bool
   float_int pairs =
     let m = Map.fromList pairs
         st = ST.fromMap m
-    in m == ST.toMap st
+    in if m == ST.toMap st && Map.keys m == ST.keys st && Map.elems m == ST.elems st
+      then do
+        and <$> sequence [ test_delete pairs
+                         , return $ test_lookup (Map.toList m) st
+                         , test_insert pairs
+                         , test_mutate st ]
+      else return False
 
-  bytestring_int :: [(ArbByteString,Int)] -> Bool
+  bytestring_int :: [(ArbByteString,Int)] -> Gen Bool
   bytestring_int pairs =
-    let m = Map.fromList $ map (first fromABS) pairs
+    let p' = map (first fromABS) pairs
+        m = Map.fromList p'
         st = ST.fromMap m
-    in m == ST.toMap st
+    in if m == ST.toMap st && Map.keys m == ST.keys st && Map.elems m == ST.elems st
+      then do
+        and <$> sequence [ test_delete p'
+                         , return $ test_lookup (Map.toList m) st
+                         , test_insert p' ]
+      else return False
 
+  test_lookup :: (Ord k, Show k, Eq v, Show v) => [(k,v)] -> StableTree k v -> Bool
+  test_lookup [] _ = True
+  test_lookup ((k,v):rest) t =
+    case ST.lookup k t of
+      Just v' | v' == v -> test_lookup rest t
+      _ -> False
+
+  test_delete :: (Show k, Ord k, Serialize k, Show v, Serialize v)
+              => [(k,v)]
+              -> Gen Bool
+  test_delete [] = return True
+  test_delete kvs = do
+    delkey <- elements (map fst kvs)
+    let m  = Map.fromList kvs
+        m' = Map.delete delkey m
+        s  = ST.fromMap m
+        s' = ST.delete delkey s
+    return (s' == ST.fromMap m')
+
+  test_insert :: (Show k, Ord k, Serialize k, Show v, Serialize v)
+              => [(k,v)]
+              -> Gen Bool
+  test_insert [] = return True
+  test_insert kvs = do
+    (inskey, insval) <- elements kvs
+    let kvs' = [(k,v) | (k,v) <- kvs, k /= inskey]
+        m    = Map.fromList kvs'
+        m'   = Map.insert inskey insval m
+        s    = ST.fromMap m
+        s'   = ST.insert inskey insval s
+    return (s' == ST.fromMap m')
+
+  test_mutate :: (Arbitrary k, Show k, Ord k, Serialize k, Arbitrary v, Show v, Serialize v)
+              => StableTree k v
+              -> Gen Bool
+  test_mutate tree | ST.size tree == 0 = return True
+  test_mutate tree = mutate (10::Int) (Set.fromList $ ST.keys tree) tree tree
+    where
+      mutate 0 _ reference accum = return $ reference == accum
+      mutate n keys ref accum = do
+        accum' <- oneof [insert, delete]
+        mutate (n-1) keys ref accum'
+        where
+        insert = do
+          key <- arbitrary
+          if Set.member key keys
+            then insert
+            else do
+              val <- arbitrary
+              return $ ST.delete key $ ST.insert key val accum
+
+        delete = do
+          key <- elements $ ST.keys accum
+          let Just val = ST.lookup key accum
+          return $ ST.insert key val $ ST.delete key accum
+
   store_int_int :: [(Int,Int)] -> Bool
   store_int_int = action
 
@@ -67,8 +150,8 @@
     go = do
       let m  = Map.fromList pairs
           st = ST.fromMap m
-      Right tid <- ST.store' store st
-      Right st' <- ST.load' load tid
+      Right tid <- SP.store' store st
+      Right st' <- SP.load' load tid
       return $ m == ST.toMap st'
 
 -- |Error type for RAM storage. Not a lot can go wrong in RAM...
@@ -97,4 +180,5 @@
       case decode fragBS of
         Left err -> return $ Left $ SerializationError err
         Right frag -> return $ Right frag
+