diff --git a/demo/Main.hs b/demo/Main.hs
--- a/demo/Main.hs
+++ b/demo/Main.hs
@@ -6,46 +6,54 @@
 ( main
 ) where
 
-import Data.StableTree             ( fromMap )
-import Data.StableTree.Persist     ( store )
-import Data.StableTree.Persist.Ram ( storage )
+import Data.StableTree
 
 import qualified Data.Map as Map
-import Data.IORef ( readIORef )
+import Control.Monad              ( foldM )
+import Control.Monad.State.Strict ( State, runState, modify )
+import Data.Map                   ( Map )
+import Data.ObjectID              ( ObjectID )
+import Data.Text                  ( Text )
 
+type S = Map ObjectID (Fragment Int Int)
+
+data DemoError = ApiError Text
+instance Error DemoError where
+  stableTreeError = ApiError
+
 -- |Make a ton of related maps, storing all of them in a RAM store and printing
 -- out the total number of unique entries in that store and how many database
 -- entries would be required from a naive database implementation every
 -- so-often.
 main :: IO ()
 main = do
-  (s, trees, values) <- storage
-  mapM_ (doRun s trees values) [0,100..1000::Int]
-  Right _ <- store s (fromMap $ Map.fromList [(a,a+1)|a<-[100..1000]])
-  prTrees trees values
-  Right _ <- store s (fromMap $ Map.fromList [(a,a+1)|a<-[200..1000]])
-  prTrees trees values
-  Right _ <- store s (fromMap $ Map.fromList [(a,a+1)|a<-[0..400]++[600..1000]])
-  prTrees trees values
+  m0 <- foldM doRun Map.empty [0,100..1000::Int]
+  let m1 = upd m0 [100..1000]
+  prTrees m1
+  let m2 = upd m1 [200..1000]
+  prTrees m2
+  let m3 = upd m2 $ [0..400] ++ [600..1000]
+  prTrees m3
 
   where
-  doRun s trees values i = do
-    mapM_ (upd s) [i..i+100]
-    putStr $ stupidCount (i+100) ++ " "
-    prTrees trees values
+  doRun :: S -> Int -> IO S
+  doRun m0 i0 = do
+    let m' = foldl (\m i -> upd m [0..i]) m0 [i0..i0+100]
+    putStr $ "naive gives: " ++ stupidCount (i0+100) ++ " / stable gives: "
+    prTrees m'
+    return m'
 
-  upd s i = do
-    let m = Map.fromList [(a,a+1) | a <- [0..i]]
-        t = fromMap m
-    store s t
+  upd :: S -> [Int] -> S
+  upd m is =
+    let t = fromMap $ Map.fromList [(a,a+1) | a <- is]
+        (_,m') = runState (save t) m
+    in m'
 
-  prTrees trees values = do
-    trMap <- readIORef trees
-    let tnum = Map.size trMap
-        tsum = sum $ map (Map.size . snd) $ Map.elems trMap
-    vsum <- readIORef values >>= return . Map.size
-    putStrLn $ show (tsum+vsum) ++ " (" ++ show tnum ++ "," ++ show tsum
-               ++ "," ++ show vsum ++ ")"
+  save :: StableTree Int Int -> State S (Either DemoError ObjectID)
+  save = store' (\oid frag -> modify (Map.insert oid frag) >> return Nothing)
+
+  prTrees m = do
+    putStrLn $ (show $ Map.size m) ++ " unique entries"
 
 -- |The typical way of storing key/value maps in SQL is to use a relational
 -- table, like this:
diff --git a/src/Data/StableTree.hs b/src/Data/StableTree.hs
--- a/src/Data/StableTree.hs
+++ b/src/Data/StableTree.hs
@@ -19,59 +19,60 @@
 -- using the dang thing now.
 module Data.StableTree
 ( StableTree(..)
-, IsKey(..)
 , fromMap
 , toMap
+, Error(..)
+, load
+, load'
+, store
+, store'
+, Fragment(..)
 ) where
 
-import Data.StableTree.Types
+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 )
-
--- | @StableTree@ is the opaque 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)
+import Data.Map       ( Map )
+import Data.Maybe     ( isNothing )
+import Data.Serialize ( Serialize )
 
 -- | Convert a 'Data.Map.Map' into a 'StableTree'.
-fromMap :: (Ord k, IsKey k) => Map k v -> StableTree k v
+fromMap :: (Ord k, Serialize k, Serialize v) => Map k v -> StableTree k v
 fromMap m = go m Map.empty
   where
   go values accum =
-    case nextBottom values of
+    case Tree.nextBottom values of
       Left incomplete ->
         if Map.null accum
           then StableTree_I incomplete
-          else case getKey incomplete of
+          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 (completeKey complete) complete accum
+          else go remain $ Map.insert (Tree.completeKey complete) complete accum
 
   buildParents completes mIncomplete accum =
-    case nextBranch completes mIncomplete of
+    case Tree.nextBranch completes mIncomplete of
       Left incomplete ->
         if Map.null accum
           then StableTree_I incomplete
-          else case getKey incomplete of
+          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 (completeKey complete) complete accum
+            let accum' = Map.insert (Tree.completeKey complete) complete accum
             in buildParents remain mIncomplete accum'
 
 -- | Convert a 'StableTree' back into a 'Data.Map.Map'
 toMap :: Ord k => StableTree k v -> Map k v
-toMap (StableTree_I t) = treeContents t
-toMap (StableTree_C t) = treeContents t
+toMap (StableTree_I t) = Tree.treeContents t
+toMap (StableTree_C t) = Tree.treeContents t
 
-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/Conversion.hs b/src/Data/StableTree/Conversion.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Conversion.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module    : Data.StableTree.Conversion
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- Functions for converting between Tree and Fragment types
+module Data.StableTree.Conversion
+( toFragments
+, fromFragments
+) where
+
+import Data.StableTree.Fragment
+import Data.StableTree.Tree
+
+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)]
+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)]
+
+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"
+
+  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"
+
+  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"
+
+
+  cannotFind oid =
+    Text.append "Failed to find object with ObjectID "
+                (Text.pack $ show oid)
+
diff --git a/src/Data/StableTree/Fragment.hs b/src/Data/StableTree/Fragment.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Fragment.hs
@@ -0,0 +1,69 @@
+{-# 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/Key.hs b/src/Data/StableTree/Key.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Key.hs
@@ -0,0 +1,68 @@
+-- |
+-- Module    : Data.StableTree.Types.Key
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- Tools for working with StableTree keys.
+module Data.StableTree.Key
+( Key(fromKey)
+, SomeKey(..)
+, Terminal
+, Nonterminal
+, wrap
+, unwrap
+) where
+
+import qualified Data.ByteString as BS
+import Data.Serialize  ( Serialize, encode )
+import Data.Bits       ( (.&.), shiftR, xor )
+import Data.ByteString ( ByteString )
+import Data.Word       ( Word8, Word64 )
+
+-- |Used to indicate that a 'Key' is terminal
+data Terminal
+
+-- |Used to indicate that a 'Key' is not terminal
+data Nonterminal
+
+-- |A wrapper for keys; this has an ephemeral 't' that will be either
+-- 'Terminal' or 'Nonterminal' depending on the result of @byte k@.
+newtype Key t k = Key { fromKey :: k } deriving ( Eq, Ord, Show )
+
+-- |A sum type to contain either a 'Terminal' or a 'Nonterminal' 'Key'
+data SomeKey k = SomeKey_T (Key Terminal k)
+               | SomeKey_N (Key Nonterminal k)
+               deriving ( Eq, Ord, Show )
+
+-- |Do the magic of wrapping up a key into a 'SomeKey'
+wrap :: Serialize k => k -> SomeKey k
+wrap k =
+  let w8 = byte k
+      x  = w8 `xor` (w8 `shiftR` 4)
+      w4 = x .&. 0xf
+  in if w4 == 0xf
+    then SomeKey_T $ Key k
+    else SomeKey_N $ Key k
+
+-- |Extract the original key from a wrapped one
+unwrap :: SomeKey k -> k
+unwrap (SomeKey_T (Key k)) = k
+unwrap (SomeKey_N (Key k)) = k
+
+-- |Calculate a single-byte hash for a 'Serialize'
+byte :: Serialize t => t -> Word8
+byte val =
+  let bs  = encode val
+      fnv = fnv1a bs
+      w32 = fnv `xor` (fnv `shiftR` 32)
+      w16 = w32 `xor` (w32 `shiftR` 16)
+      w8  = w16 `xor` (w16 `shiftR` 8)
+  in toEnum $ fromEnum $ 0xff .&. w8
+
+fnv1a :: ByteString -> Word64
+fnv1a = BS.foldl upd basis
+  where
+  upd hsh oct = prime * (hsh `xor` (toEnum $ fromEnum oct))
+  prime       = 1099511628211
+  basis       = 14695981039346656037
+
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
@@ -9,42 +9,23 @@
 -- 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 'Build' for custom data types.
+-- a user can also implement 'Serialize' for custom data types.
 module Data.StableTree.Persist
-( Store(..)
-, Build(..)
-, Error(..)
-, Id
-, encodeId
-, decodeId
+( Error(..)
 , load
+, load'
 , store
-, buildBinary
-, buildSerialize
+, store'
 ) where
 
-import Data.StableTree.Types hiding ( hash )
-import Data.StableTree ( StableTree(..) )
+import Data.StableTree.Conversion ( toFragments, fromFragments )
+import Data.StableTree.Fragment   ( Fragment(..) )
+import Data.StableTree.Tree       ( StableTree(..) )
 
-import qualified Data.Binary as B
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as Lazy
 import qualified Data.Map as Map
-import qualified Data.Serialize as S
-import Blaze.ByteString.Builder            ( Builder, toByteString )
-import Blaze.ByteString.Builder.ByteString ( fromByteString, fromLazyByteString  )
-import Blaze.ByteString.Builder.Char8      ( fromShow, fromString, fromChar )
-import Blaze.ByteString.Builder.Word       ( fromWord64be )
-import Control.Arrow                       ( second )
-import Control.Monad.Except                ( ExceptT, runExceptT, lift, throwError )
-import Crypto.Hash.Skein256                ( hash )
-import Data.ByteString                     ( ByteString )
-import Data.Int                            ( Int8, Int16, Int32, Int64 )
-import Data.Map                            ( Map )
-import Data.Monoid                         ( (<>), mconcat )
-import Data.Serialize.Get                  ( runGet, getWord64be )
-import Data.Text                           ( Text )
-import Data.Word                           ( Word, Word8, Word16, Word32, Word64 )
+import Data.ObjectID  ( ObjectID )
+import Data.Serialize ( Serialize(..) )
+import Data.Text      ( Text )
 
 -- |Things go wrong with end-user storage, but things can also go wrong with
 -- reconstructing tree values. Implement 'stableTreeError' to allow 'load' and
@@ -52,251 +33,85 @@
 class Error e where
   stableTreeError :: Text -> e
 
--- |The opaque type to identify values and branches of trees.
-data Id = Id !Word64 !Word64 !Word64 !Word64 deriving ( Show, Eq, Ord )
-
--- |Convert an Id into a 32-byte ByteString. Useful for actual storage of Ids
-encodeId :: Id -> ByteString
-encodeId = toByteString . build
-
--- |Convert a stored ByteString back into an Id. Gives a "Left err" if the
--- given ByteString isn't 32 bytes long
-decodeId :: ByteString -> Either String Id
-decodeId = runGet decode
+-- |Record the tree into storage. This works like a fold, where the function
+-- takes an accumulating state and each tree fragment to store, while returning
+-- either an error message (which will abort the loop immediately) or the next
+-- state for the accumulator.
+--
+-- Any fragment referring to other fragments ('FragmentBranch' fragments) will
+-- be given to the fold only after all their children have been given to the
+-- fold. Exact ordering beyond that is not guaranteed, but the current
+-- behaviour is post-order depth-first traversal.
+store :: (Monad m, Error e, Ord k)
+      => (a -> ObjectID -> Fragment k v -> m (Either e a))
+      -> 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
   where
-  decode = do
-    a <- getWord64be
-    b <- getWord64be
-    c <- getWord64be
-    d <- getWord64be
-    return $ Id a b c d
-
--- |Write appropriate functions here to load and store primitive parts of
--- trees.
-data Store m e k v = Store
-  { loadTree   :: Id -> m (Either e (Depth, Map k (ValueCount, Id)))
-  , loadValue  :: Id -> m (Either e v)
-  , storeTree  :: Id -> Depth -> Map k (ValueCount, Id) -> m (Maybe e)
-  , storeValue :: Id -> v -> m (Maybe e)
-  }
-
--- |Retrieve a tree given its id.
-load :: (Monad m, IsKey k, Ord k, Error e)
-     => Store m e k v
-     -> Id
-     -> m (Either e (StableTree k v))
-load s i = runExceptT $ load' s i
+  go accum [] = return $ Right accum
+  go accum ((fragid, frag):frags) =
+    fn accum fragid frag >>= \case
+      Left err -> return $ Left err
+      Right accum' -> go accum' frags
 
-load' :: (Monad m, IsKey k, Ord k, Error e)
-      => Store m e k v
-      -> Id
-      -> ExceptT e m (StableTree k v)
-load' storage treeId =
-  liftEither (loadTree storage treeId) >>= \case
-    (0, contents)     -> loadBottom contents
-    (depth, contents) -> loadBranch depth contents
+store' :: (Monad m, Error e, Ord k)
+       => (ObjectID -> Fragment k v -> m (Maybe e))
+       -> StableTree k v
+       -> m (Either e ObjectID)
+store' fn = store fn' undefined
   where
-  loadBottom contents = do
-    vals <- loadValues contents Map.empty
-    case nextBottom vals of
-      Left i -> return $ StableTree_I i
-      Right (c,r) ->
-        if Map.null r
-          then return $ StableTree_C c
-          else err "Too many terminal keys in loadBottom"
-
-  loadValues cont accum =
-    case Map.minViewWithKey cont of
-      Nothing -> return accum
-      Just ((k,(_,valId)),rest) -> do
-        v <- liftEither $ loadValue storage valId
-        loadValues rest $ Map.insert k v accum
-
-  loadBranch depth contents = do
-    children <- loadChildren contents Map.empty
-    let classify s = case s of StableTree_I i -> Right i
-                               StableTree_C c -> Left c
-        (cs, is)   = Map.mapEither classify children
-    case Map.minViewWithKey is >>= return . second Map.minViewWithKey of
-      Nothing -> go cs Nothing
-      Just (_, Just (_,_)) ->
-        err "Too many incomplete trees in loadBranch"
-      Just ((ik,iv), Nothing) ->
-        case Map.maxViewWithKey cs of
-          Nothing -> go cs $ Just (ik, iv)
-          Just ((ck,_), _) ->
-            if ck > ik
-              then err "Saw complete trees after incomplete..."
-              else go cs $ Just (ik, iv)
-    where
-    go completes mIncomplete =
-      case nextBranch completes mIncomplete of
-        Left i ->
-          if getDepth i == depth
-            then return $ StableTree_I i
-            else err "Depth mismatch in loadBranch"
-        Right (c,m) | Map.null m ->
-          if getDepth c == depth
-            then return $ StableTree_C c
-            else err "Depth mismatch in loadBranch"
-        _ -> err "Too many terminal keys in loadBranch"
-
-  loadChildren cont accum =
-    case Map.minViewWithKey cont of
-      Nothing -> return accum
-      Just ((k,(_,valId)),rest) -> do
-        subtree <- load' storage valId
-        loadChildren rest $ Map.insert k subtree accum
-
-  err = throwError . stableTreeError
-
--- |Store a tree using a 'Store' and return its calculated 'Id'
-store :: (Monad m, Build k, Ord k, Build v)
-      => Store m e k v
-      -> StableTree k v
-      -> m (Either e Id)
-store storage (StableTree_I i) = runExceptT $ store' storage i
-store storage (StableTree_C c) = runExceptT $ store' storage c
+  fn' _accum oid frag =
+    fn oid frag >>= \case
+      Nothing -> return $ Right oid
+      Just err -> return $ Left err
 
-store' :: (Monad m, Build k, Ord k, Build v)
-       => Store m e k v
-       -> Tree c k v
-       -> ExceptT e m Id
-store' storage tree =
-  case branchContents tree of
-    Left subtrees -> storeBranch subtrees
-    Right kvmap -> storeBottom kvmap
+load :: (Monad m, Error e, Ord k, Serialize k, Serialize v)
+     => (a -> ObjectID -> m (Either e (a, Fragment k v)))
+     -> a
+     -> ObjectID
+     -> m (Either e (a, StableTree k v))
+load fn a0 top =
+  recur a0 Map.empty [top] >>= \case
+    Left err ->
+      return $ Left err
+    Right (accum, frags) ->
+      case Map.lookup top frags of
+        Nothing ->
+          return $ Left (stableTreeError "load/recur failed to find top")
+        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)
 
   where
-  storeBranch (complete, mIncomplete) = do
-    key_ids <- storeSubtrees complete Map.empty
-    case mIncomplete of
-      Nothing -> storeKeyIds key_ids
-      Just (k,c,v) -> do
-        treeId <- store' storage v
-        storeKeyIds $ Map.insert k (c,treeId) key_ids
-
-  storeSubtrees kvmap accum =
-    case Map.minViewWithKey kvmap of
-      Nothing -> return accum
-      Just ((k,(c,t)), rest) -> do
-        treeId <- store' storage t
-        storeSubtrees rest $ Map.insert k (c,treeId) accum
-
-  storeBottom kvmap = do
-    key_ids <- storeValues kvmap Map.empty
-    storeKeyIds key_ids
-
-  storeValues kvmap accum = do
-    case Map.minViewWithKey kvmap of
-      Nothing -> return accum
-      Just ((k,v), rest) -> do
-        let valId = calcId $ build v
-        _ <- liftMaybe $ storeValue storage valId v
-        storeValues rest $ Map.insert k (1,valId) accum
-
-  storeKeyIds key_ids =
-    let depth = getDepth tree
-        valId = treeHash depth $ Map.map snd key_ids
-    in do liftMaybe $ storeTree storage valId depth key_ids
-          return valId
-
-treeHash :: Build k => Int -> Map k Id -> Id
-treeHash depth contents =
-  let builders = [(build k, build v) | (k,v) <- Map.toAscList contents]
-      w_len    = [(len k, k, v) | (k, v) <- builders]
-      bodybs   = toByteString $ mconcat [l <> k <> v | (l,k,v) <- w_len]
-      bodylen  = fromShow $ BS.length bodybs
-      header   = (fromString "tree ")
-                 <> bodylen <> fromChar ' '
-                 <> fromShow depth <> fromChar '\0'
-  in calcId $ header <> fromByteString bodybs
-  where
-  len = fromShow . BS.length . toByteString
+  recur accum frags [] = return $ Right (accum, frags)
+  recur accum frags (oid:rest) = fn accum oid >>= \case
+    Left err -> return $ Left err
+    Right (accum', frag@(FragmentBottom _)) ->
+      recur accum' (Map.insert oid frag frags) rest
+    Right (accum', frag) ->
+      let children = fragmentChildren frag
+          oids     = map snd $ Map.elems children
+      in recur accum' (Map.insert oid frag frags) (oids ++ rest)
 
-calcId :: Builder -> Id
-calcId = right . decodeId . hash 256 . toByteString
+load' :: (Monad m, Error e, Ord k, Serialize k, Serialize v)
+      => (ObjectID -> m (Either e (Fragment k v)))
+      -> ObjectID
+      -> m (Either e (StableTree k v))
+load' fn top =
+  load fn' undefined top >>= \case
+    Left err -> return $ Left err
+    Right (_, tree) -> return $ Right tree
   where
-  right ei =
-    case ei of
-      Left _ -> error "Got a left!?"
-      Right v -> v
-
-liftEither :: Monad m => m (Either a b) -> ExceptT a m b
-liftEither act =
-  lift act >>= \case
-    Left err -> throwError err
-    Right val -> return val
-
-liftMaybe :: Monad m => m (Maybe e) -> ExceptT e m ()
-liftMaybe act =
-  lift act >>= \case
-    Just err -> throwError err
-    Nothing -> return ()
-
--- |Typeclass to generate unique 'ByteString's for StableTree keys and values.
--- Used to generate the unique identities for values and branches.
-class Build t where
-  build :: t -> Builder
-
--- |Generate a builder for something that is already a 'Binary'
-buildBinary :: B.Binary t => t -> Builder
-buildBinary = fromLazyByteString . B.encode
-
--- |Generate a builder for something that is already a 'Serialize'
-buildSerialize :: S.Serialize t => t -> Builder
-buildSerialize = fromByteString . S.encode
-
-instance Build Id where
-  build (Id a b c d) = w a <> w b <> w c <> w d
-    where
-    w = fromWord64be
-
-instance Build Char where
-  build = buildSerialize
-
-instance Build Double where
-  build = buildSerialize
-
-instance Build Float where
-  build = buildSerialize
-
-instance Build Int where
-  build = buildSerialize
-
-instance Build Int8 where
-  build = buildSerialize
-
-instance Build Int16 where
-  build = buildSerialize
-
-instance Build Int32 where
-  build = buildSerialize
-
-instance Build Int64 where
-  build = buildSerialize
-
-instance Build Integer where
-  build = buildSerialize
-
-instance Build Word where
-  build = buildSerialize
-
-instance Build Word8 where
-  build = buildSerialize
-
-instance Build Word16 where
-  build = buildSerialize
-
-instance Build Word32 where
-  build = buildSerialize
-
-instance Build Word64 where
-  build = buildSerialize
-
-instance Build ByteString where
-  build = fromByteString
-
-instance Build Lazy.ByteString where
-  build = fromLazyByteString
+  fn' st oid =
+    fn oid >>= \case
+      Left err -> return $ Left err
+      Right frag -> return $ Right (st, frag)
 
diff --git a/src/Data/StableTree/Persist/Ram.hs b/src/Data/StableTree/Persist/Ram.hs
deleted file mode 100644
--- a/src/Data/StableTree/Persist/Ram.hs
+++ /dev/null
@@ -1,61 +0,0 @@
--- |
--- Module    : Data.StableTree.Persist.Ram
--- Copyright : Jeremy Groven
--- License   : BSD3
---
--- A sample implementation of StableTree storage that just writes stuff to some
--- Maps that are wrapped in IORefs.
-module Data.StableTree.Persist.Ram
-( RamError(..)
-, storage
-) where
-
-import Data.StableTree.Persist ( Id, Error(..), Store(..) )
-
-import qualified Data.Map as Map
-import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )
-import Data.Map   ( Map )
-import Data.Text  ( Text )
-
--- |Error type for RAM storage. Not a lot can go wrong in RAM...
-data RamError = NoTree Id
-              | NoVal Id
-              | ApiError Text
-              deriving ( Show )
-
-instance Error RamError where
-  stableTreeError = ApiError
-
--- |Create a new RAM store
-storage :: IO ( Store IO RamError k v
-              , IORef (Map Id (Int,Map k (Int,Id)))
-              , IORef (Map Id v) )
-storage = do
-  trees  <- newIORef Map.empty
-  values <- newIORef Map.empty
-  return ( Store (lt trees) (lv values) (st trees) (sv values)
-         , trees
-         , values )
-  where
-  lt store tid = do
-    m <- readIORef store
-    case Map.lookup tid m of
-      Nothing -> return $ Left $ NoTree tid
-      Just (depth, children) ->
-        return $ Right (depth, children)
-
-  lv store vid = do
-    m <- readIORef store
-    case Map.lookup vid m of
-      Nothing -> return $ Left $ NoVal vid
-      Just v -> return $ Right v
-
-  st store tid depth tree = do
-    modifyIORef store $ Map.insert tid (depth,tree)
-    return Nothing
-
-  sv store vid val = do
-    -- putStrLn $ "Storing " ++ show vid
-    modifyIORef store $ Map.insert vid val
-    return Nothing
-
diff --git a/src/Data/StableTree/Tree.hs b/src/Data/StableTree/Tree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Tree.hs
@@ -0,0 +1,502 @@
+{-# 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,345 +1,17 @@
-{-# LANGUAGE GADTs #-}
 -- |
 -- Module    : Data.StableTree.Types
 -- 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.
+-- Definitions of primitive types used in different modules of stable-tree
 module Data.StableTree.Types
-( IsKey(..)
-, Tree(..)
-, Complete
-, Incomplete
-, Depth
+( Depth
 , ValueCount
-, nextBottom
-, nextBranch
-, getKey
-, completeKey
-, treeContents
-, branchContents
-, getDepth
-, getValueCount
 ) where
 
-import Data.StableTree.Types.Key
-
-import qualified Data.Map as Map
-import Control.Arrow ( first, second )
-import Data.Map ( Map )
-import Data.List ( intercalate )
-
--- |Used to indicate that a 'Tree' is not complete
-data Incomplete 
-
--- |Used to indicate that a 'Tree' is complete
-data Complete   
-
 -- |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
-
--- |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 :: (SomeKey k, v)
-         -> (SomeKey k, v)
-         -> Map (Key Nonterminal k) v
-         -> (Key Terminal k, v)
-         -> Tree Complete k v
-
-  Branch :: 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 :: Maybe (SomeKey k, v)
-           -> Tree Incomplete k v
-
-  -- Any number of items, but not ending with a terminal key
-  IBottom1 :: (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 :: Depth
-           -> (SomeKey k, ValueCount, Tree Incomplete k v)
-           -> Tree Incomplete k v
-
-  -- A joining of a single complete and maybe an incomplete
-  IBranch1 :: 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 :: 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, IsKey k)
-           => 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
-    Nothing -> Left $ IBottom0 Nothing
-    Just ((k,v), Nothing) -> Left $ IBottom0 $ Just (wrap k, v)
-    Just (f1, Just (f2, remain)) ->
-      go (first wrap f1) (first wrap f2) Map.empty remain
-
-  where
-  go f1 f2 accum remain =
-    case Map.minViewWithKey remain of
-      Nothing ->
-        Left $ IBottom1 f1 f2 accum
-      Just ((k, v), remain') ->
-        case wrap k of
-          SomeKey_N nonterm ->
-            go f1 f2 (Map.insert nonterm v accum) remain'
-          SomeKey_T term ->
-            Right (Bottom 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, IsKey k)
-           => 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 Nothing
-        Just (ik, iv) -> Left $ IBranch0 depth (wrap ik, getValueCount iv, iv)
-    Just ((k,v), Nothing) ->
-      Left $ IBranch1 depth (wrap k, getValueCount v, v) $ wrapMKey mIncomplete
-    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 ->
-        Left $ IBranch2 depth f1 f2 accum $ wrapMKey mIncomplete
-      Just ((SomeKey_T term,c,v), remain') ->
-        Right ( Branch depth f1 f2 accum (term, c, v), remain' )
-      Just ((SomeKey_N nonterm,c,v), remain') ->
-        go f1 f2 (Map.insert nonterm (c,v) accum) remain'
-
-  wrapKey (k,v) = (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"
-
--- |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 $ unwrap k
-getKey (IBottom0 Nothing)         = Nothing
-getKey (IBottom0 (Just (k,_)))    = Just $ unwrap k
-getKey (IBottom1 (k,_) _ _)       = Just $ unwrap k
-getKey (Branch _ (k,_,_) _ _ _)   = Just $ unwrap k
-getKey (IBranch0 _ (k,_,_))       = Just $ unwrap k
-getKey (IBranch1 _ (k,_,_) _)     = Just $ unwrap k
-getKey (IBranch2 _ (k,_,_) _ _ _) = Just $ 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,_) _ _ _)     = unwrap k
-completeKey (Branch _ (k,_,_) _ _ _)   = 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 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 fromKey terms
-      conts  = Map.insert (unwrap k1) v1
-             $ Map.insert (unwrap k2) v2
-             $ Map.insert (fromKey kt) vt
-             terms'
-  in Right conts
-branchContents (Branch _d (k1,c1,v1) (k2,c2,v2) terms (kt,ct,vt)) =
-  let terms' = Map.mapKeys fromKey terms
-      conts  = Map.insert (unwrap k1) (c1,v1)
-             $ Map.insert (unwrap k2) (c2,v2)
-             $ Map.insert (fromKey kt) (ct,vt)
-             terms'
-  in Left (conts, Nothing)
-branchContents (IBottom0 Nothing) =
-  Right Map.empty
-branchContents (IBottom0 (Just (k,v))) =
-  Right $ Map.singleton (unwrap k) v
-branchContents (IBottom1 (k1,v1) (k2,v2) terms) =
-  let terms' = Map.mapKeys fromKey terms
-      conts  = Map.insert (unwrap k1) v1
-             $ Map.insert (unwrap k2) v2
-             terms'
-  in Right conts
-branchContents (IBranch0 _d (ik,ic,iv)) =
-  Left (Map.empty, Just (unwrap ik, ic, iv))
-branchContents (IBranch1 _d (k1,c1,v1) mIncomplete) =
-  Left ( Map.singleton (unwrap k1) (c1,v1)
-       , mIncomplete >>= (\(k,c,v) -> return (unwrap k,c,v)))
-branchContents (IBranch2 _d (k1,c1,v1) (k2,c2,v2) terms mIncomplete) =
-  let terms' = Map.mapKeys fromKey terms
-      conts  = Map.insert (unwrap k1) (c1,v1)
-             $ Map.insert (unwrap k2) (c2,v2)
-             terms'
-  in Left (conts, mIncomplete >>= \(k,c,v) -> return (unwrap k, c, v))
-
-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 ++ ">"
 
diff --git a/src/Data/StableTree/Types/Key.hs b/src/Data/StableTree/Types/Key.hs
deleted file mode 100644
--- a/src/Data/StableTree/Types/Key.hs
+++ /dev/null
@@ -1,146 +0,0 @@
--- |
--- Module    : Data.StableTree.Types.Key
--- Copyright : Jeremy Groven
--- License   : BSD3
---
--- Tools for working with StableTree keys. Just about anything can be a key, so
--- long as there's a sane way to implement IsKey and the standard Ord class.
---
--- Typical users don't need to worry about anything here other than perhaps
--- IsKey.
-module Data.StableTree.Types.Key
-( IsKey(..)
-, Key(fromKey)
-, SomeKey(..)
-, Terminal
-, Nonterminal
-, wrap
-, unwrap
-, hashSerialize
-, hashBinary
-, hashByteString
-) where
-
-import qualified Data.ByteString.Lazy as Lazy
-import qualified Data.ByteString as BS
-import qualified Data.Serialize  as S
-import qualified Data.Binary as B
-import Data.Bits       ( (.&.), shiftR, xor )
-import Data.ByteString ( ByteString )
-import Data.Int        ( Int8, Int16, Int32, Int64 )
-import Data.Word       ( Word, Word8, Word16, Word32, Word64 )
-
--- |Used to indicate that a 'Key' is terminal
-data Terminal
-
--- |Used to indicate that a 'Key' is not terminal
-data Nonterminal
-
--- |A wrapper for keys; this has an ephemeral 't' that will be either
--- 'Terminal' or 'Nonterminal' depending on the result of @hash k@.
-newtype Key t k = Key { fromKey :: k } deriving ( Eq, Ord, Show )
-
--- |A sum type to contain either a 'Terminal' or a 'Nonterminal' 'Key'
-data SomeKey k = SomeKey_T (Key Terminal k)
-               | SomeKey_N (Key Nonterminal k)
-               deriving ( Eq, Ord, Show )
-
--- |Do the magic of wrapping up a key into a 'SomeKey'
-wrap :: IsKey k => k -> SomeKey k
-wrap k =
-  let w8 = hash k
-      x  = w8 `xor` (w8 `shiftR` 4)
-      w4 = x .&. 0xf
-  in if w4 == 0xf
-    then SomeKey_T $ Key k
-    else SomeKey_N $ Key k
-
--- |Extract the original key from a wrapped one
-unwrap :: SomeKey k -> k
-unwrap (SomeKey_T (Key k)) = k
-unwrap (SomeKey_N (Key k)) = k
-
--- |Calculate a hash for an instance of 'S.Serialize'
-hashSerialize :: S.Serialize t => t -> Word8
-hashSerialize = hashByteString . S.encode
-
--- |Calculate a hash for an instance of 'B.Binary'
-hashBinary :: B.Binary t => t -> Word8
-hashBinary = hashByteString . Lazy.toStrict . B.encode
-
--- |Calculate a hash for a 'ByteString'
-hashByteString :: ByteString -> Word8
-hashByteString bs =
-  let fnv = fnv1a bs
-      w32 = fnv `xor` (fnv `shiftR` 32)
-      w16 = w32 `xor` (w32 `shiftR` 16)
-      w8  = w16 `xor` (w16 `shiftR` 8)
-  in toEnum $ fromEnum $ 0xff .&. w8
-
--- | Type class for anything that we can use as a key. The goal here is to wrap
--- up a function that can generate a high-entropy eight-bit "hash". Speed is
--- somewhat important here, but since we only actually look at four bits of the
--- hash, it really shouldn't be a problem to quickly generate sufficiently
--- random data.
---
--- Implementors probably want to use 'hashSerialize', 'hashBinary', or
--- 'hashByteString' when writing their 'hash' functions.
-class IsKey k where
-  -- |Generate an 8-bit hash
-  hash :: k -> Word8
-
-instance IsKey Char where
-  hash = hashSerialize
-
-instance IsKey Double where
-  hash = hashSerialize
-
-instance IsKey Float where
-  hash = hashSerialize
-
-instance IsKey Int where
-  hash = hashSerialize
-
-instance IsKey Int8 where
-  hash = hashSerialize
-
-instance IsKey Int16 where
-  hash = hashSerialize
-
-instance IsKey Int32 where
-  hash = hashSerialize
-
-instance IsKey Int64 where
-  hash = hashSerialize
-
-instance IsKey Integer where
-  hash = hashSerialize
-
-instance IsKey Word where
-  hash = hashSerialize
-
-instance IsKey Word8 where
-  hash = hashSerialize
-
-instance IsKey Word16 where
-  hash = hashSerialize
-
-instance IsKey Word32 where
-  hash = hashSerialize
-
-instance IsKey Word64 where
-  hash = hashSerialize
-
-instance IsKey ByteString where
-  hash = hashByteString
-
-instance IsKey Lazy.ByteString where
-  hash = hashByteString . Lazy.toStrict
-
-fnv1a :: ByteString -> Word64
-fnv1a = BS.foldl upd basis
-  where
-  upd hsh oct = prime * (hsh `xor` (toEnum $ fromEnum oct))
-  prime       = 1099511628211
-  basis       = 14695981039346656037
-
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.4.1
+version:             0.5.0
 synopsis:            Trees whose branches are resistant to change
 -- description:         
 homepage:            https://github.com/tsuraan/stable-tree
@@ -19,7 +19,10 @@
 executable demo
   build-depends:       base >=4.6 && <4.8
                      , containers
+                     , mtl >= 2.2.1
+                     , objectid
                      , stable-tree
+                     , text
   hs-source-dirs:      demo
   main-is:             Main.hs
   default-language:    Haskell2010
@@ -27,10 +30,12 @@
 
 library
   exposed-modules:     Data.StableTree
+                     , Data.StableTree.Conversion
+                     , Data.StableTree.Fragment
                      , Data.StableTree.Types
-                     , Data.StableTree.Types.Key
+                     , Data.StableTree.Key
+                     , Data.StableTree.Tree
                      , Data.StableTree.Persist
-                     , Data.StableTree.Persist.Ram
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base >=4.6 && <4.8
@@ -39,8 +44,8 @@
                      , bytestring
                      , cereal
                      , containers
-                     , cryptohash >= 0.5.1
                      , mtl >= 2.2.1
+                     , objectid >= 0.1.0.2
                      , text
   hs-source-dirs:      src
   default-language:    Haskell2010
@@ -50,10 +55,15 @@
   type:                exitcode-stdio-1.0
   main-is:             TestAll.hs
   build-depends:       base >=4.6 && < 4.8
+                     , bytestring
                      , bytestring-arbitrary
+                     , cereal
                      , containers
+                     , mtl >= 2.2.1
+                     , objectid
                      , QuickCheck >= 2.1
                      , stable-tree
+                     , text
                      , tasty
                      , tasty-quickcheck
   hs-source-dirs:      tests
diff --git a/tests/TestAll.hs b/tests/TestAll.hs
--- a/tests/TestAll.hs
+++ b/tests/TestAll.hs
@@ -1,18 +1,22 @@
+{-# LANGUAGE LambdaCase #-}
 module Main
 ( main
 ) where
 
 import qualified Data.StableTree as ST
-import Data.StableTree.Persist ( store, load )
-import Data.StableTree.Persist.Ram ( storage )
+import Data.StableTree ( Fragment, Error(..) )
 
 import qualified Data.Map as Map
-import Control.Arrow ( first )
-import Data.ByteString.Arbitrary ( ArbByteString(..) )
+import Control.Arrow              ( first )
+import Control.Monad.State.Strict ( State, runState, modify, gets )
+import Data.ByteString            ( ByteString )
+import Data.ByteString.Arbitrary  ( ArbByteString(..) )
+import Data.Map                   ( Map )
+import Data.ObjectID              ( ObjectID )
+import Data.Serialize             ( Serialize, encode, decode )
+import Data.Text                  ( Text )
 import Test.Tasty
-import Test.Tasty.QuickCheck ( testProperty )
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
+import Test.Tasty.QuickCheck      ( testProperty )
 
 main :: IO ()
 main = defaultMain $
@@ -48,30 +52,49 @@
         st = ST.fromMap m
     in m == ST.toMap st
 
-  store_int_int :: [(Int,Int)] -> Property
-  store_int_int pairs = monadicIO $ do
-    (s,_,_) <- run storage
-    let m = Map.fromList pairs
-        st = ST.fromMap m
-    Right tid <- run $ store s st
-    Right st' <- run $ load s tid
-    assert $ m == ST.toMap st'
+  store_int_int :: [(Int,Int)] -> Bool
+  store_int_int = action
 
-  store_float_int :: [(Float,Int)] -> Property
-  store_float_int pairs = monadicIO $ do
-    (s,_,_) <- run storage
-    let m  = Map.fromList pairs
-        st = ST.fromMap m
-    Right tid <- run $ store s st
-    Right st' <- run $ load s tid
-    assert $ m == ST.toMap st'
+  store_float_int :: [(Float,Int)] -> Bool
+  store_float_int = action
 
-  store_bytestring_int :: [(ArbByteString,Int)] -> Property
-  store_bytestring_int pairs = monadicIO $ do
-    (s,_,_) <- run storage
-    let m  = Map.fromList $ map (first fromABS) pairs
-        st = ST.fromMap m
-    Right tid <- run $ store s st
-    Right st' <- run $ load s tid
-    assert $ m == ST.toMap st'
+  store_bytestring_int :: [(ArbByteString,Int)] -> Bool
+  store_bytestring_int = action . map (first fromABS)
+
+  action :: (Eq k, Ord k, Serialize k, Eq v, Serialize v) => [(k,v)] -> Bool
+  action pairs = fst $ runState go Map.empty
+    where
+    go = do
+      let m  = Map.fromList pairs
+          st = ST.fromMap m
+      Right tid <- ST.store' store st
+      Right st' <- ST.load' load tid
+      return $ m == ST.toMap st'
+
+-- |Error type for RAM storage. Not a lot can go wrong in RAM...
+data RamError = NotFound ObjectID
+              | SerializationError String
+              | ApiError Text
+              deriving ( Show )
+
+instance Error RamError where
+  stableTreeError = ApiError
+
+type StableTreeState = State (Map ByteString ByteString)
+
+store :: (Ord k, Serialize k, Serialize v)
+      => ObjectID -> Fragment k v -> StableTreeState (Maybe RamError)
+store oid frag = do
+  modify $ Map.insert (encode oid) (encode frag)
+  return Nothing
+
+load :: (Ord k, Serialize k, Serialize v)
+     => ObjectID -> StableTreeState (Either RamError (Fragment k v))
+load oid =
+  gets (Map.lookup $ encode oid) >>= \case
+    Nothing -> return $ Left $ NotFound oid
+    Just fragBS ->
+      case decode fragBS of
+        Left err -> return $ Left $ SerializationError err
+        Right frag -> return $ Right frag