diff --git a/src/Data/StableTree.hs b/src/Data/StableTree.hs
--- a/src/Data/StableTree.hs
+++ b/src/Data/StableTree.hs
@@ -25,14 +25,13 @@
 , keys
 , elems
 , assocs
-, fmap
 , append
 , concat
 , toMap
 ) where
 
 import Data.StableTree.Build      ( fromMap, empty, append, concat )
-import Data.StableTree.Mutate     ( insert, delete, fmap )
+import Data.StableTree.Mutate     ( insert, delete )
 import Data.StableTree.Properties ( toMap, size, lookup, keys, elems, assocs )
 import Data.StableTree.Types      ( StableTree )
 
diff --git a/src/Data/StableTree/Build.hs b/src/Data/StableTree/Build.hs
--- a/src/Data/StableTree/Build.hs
+++ b/src/Data/StableTree/Build.hs
@@ -27,7 +27,7 @@
 
 import qualified Data.StableTree.Key as Key
 import qualified Data.StableTree.Properties as Properties
-import Data.StableTree.Key   ( SomeKey(..), fromKey, unwrap )
+import Data.StableTree.Key   ( StableKey, SomeKey(..), fromKey, unwrap )
 import Data.StableTree.Types
 
 import qualified Data.Map as Map
@@ -36,48 +36,47 @@
 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 :: (Ord k, StableKey k) => 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 :: (Ord k, StableKey k) => 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)
+append :: (Ord k, StableKey k)
        => 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)
+concat :: (Ord k, StableKey k)
        => [StableTree k v] -> StableTree k v
 concat = go [] []
   where
-  go :: (Ord k, Serialize k, Serialize v)
+  go :: (Ord k, StableKey k)
      => [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
+      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
+      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)
+  branch :: (Ord k, StableKey k)
          => Tree (S d) c k v
          -> [Tree Z Complete k v]
          -> [Tree Z Incomplete k v]
@@ -92,7 +91,7 @@
 
 -- |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)
+consume :: (Ord k, StableKey k)
         => [Tree d Complete k v]
         -> Maybe (Tree d Incomplete k v)
         -> StableTree k v
@@ -119,7 +118,7 @@
 -- 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)
+consumeMap :: (Ord k, StableKey k)
            => Map k v
            -> ([Tree Z Complete k v], Maybe (Tree Z Incomplete k v))
 consumeMap = go []
@@ -138,7 +137,7 @@
 -- 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)
+consumeBranches :: (Ord k, StableKey k)
                 => 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))
@@ -156,7 +155,7 @@
 -- |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)
+consumeBranches' :: (Ord k, StableKey k)
                  => [Tree d Complete k v]
                  -> Maybe (Tree d Incomplete k v)
                  -> ([Tree (S d) Complete k v], Maybe (Tree (S d) Incomplete k v))
@@ -174,7 +173,7 @@
 -- 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)
+nextBottom :: (Ord k, StableKey k)
            => Map k v
            -> Either (Tree Z Incomplete k v)
                      (Tree Z Complete k v, Map k v)
@@ -191,20 +190,20 @@
                 Just ((k,v), Nothing) -> Just (Key.wrap k, v)
                 _ ->
                   error "This is just here to satisfy a broken exhaustion check"
-          b = mkIBottom0 m
+          b = IBottom0 m
       in Left b
 
   where
   go f1 f2 accum remain =
     case Map.minViewWithKey remain of
       Nothing ->
-        Left $ mkIBottom1 f1 f2 accum
+        Left $ IBottom1 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')
+            Right (Bottom f1 f2 accum (term, v), remain')
 
 -- | Result of the 'nextBranch' function; values are described below.
 data NextBranch d k v
@@ -217,7 +216,7 @@
 -- '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)
+nextBranch :: (Ord k, StableKey k)
            => Map k (Tree d Complete k v)
            -> Maybe (k, Tree d Incomplete k v)
            -> NextBranch d k v
@@ -231,12 +230,12 @@
           Empty
         Just (ik, iv) ->
           let tup = (Key.wrap ik, getValueCount iv, iv)
-              b   = mkIBranch0 depth tup
+              b   = IBranch0 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
+      in Final $ IBranch1 depth tup may
     Just (f1, Just (f2, remain)) ->
       go (wrapKey f1) (wrapKey f2) Map.empty remain
 
@@ -246,10 +245,10 @@
     in case popd of
       Nothing ->
         let may = wrapMKey mIncomplete
-        in Final $ mkIBranch2 depth f1 f2 accum may 
+        in Final $ IBranch2 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'
+        in More (Branch depth f1 f2 accum tup) remain'
       Just ((SomeKey_N nonterm,c,v), remain') ->
         go f1 f2 (Map.insert nonterm (c,v) accum) remain'
 
@@ -277,7 +276,7 @@
 -- 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)
+merge :: (Ord k, StableKey k)
       => [Tree d Complete k v]
       -> Maybe (Tree d Incomplete k v)
       -> [Tree d Complete k v]
@@ -289,11 +288,11 @@
   (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
+    (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 =
@@ -302,7 +301,7 @@
         (after, minc) = consumeMap (Map.union lc rc)
     in (b ++ after, minc)
 
-  branch :: (Ord k, Serialize k, Serialize v)
+  branch :: (Ord k, StableKey k)
            => [Tree (S d) Complete k v]
            -> Tree (S d) Incomplete k v
            -> Tree (S d) Incomplete k v
@@ -327,13 +326,13 @@
 
 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
+    (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)
+  bottom :: (Ord k, StableKey k)
            => [Tree Z Complete k v]
            -> Tree Z Incomplete k v
            -> Tree Z Complete k v
@@ -347,7 +346,7 @@
         (comp, Nothing) -> (b++comp++r, m)
         (comp, justinc) -> merge (b++comp) justinc r m
 
-  branch :: (Ord k, Serialize k, Serialize v)
+  branch :: (Ord k, StableKey k)
            => [Tree (S d) Complete k v]
            -> Tree (S d) Incomplete k v
            -> Tree (S d) Complete k v
@@ -373,7 +372,7 @@
         (newcomp, newminc)   = consumeBranches lcomp' linc'
     in merge (b ++ newcomp) newminc r m
 
-concat' :: (Ord k, Serialize k, Serialize v)
+concat' :: (Ord k, StableKey k)
         => [Tree Z Complete k v]
         -> [Tree Z Incomplete k v]
         -> StableTree k v
@@ -430,14 +429,14 @@
   sort' = sortBy (comparing (\(a,b,_) -> (a,b)))
 
   completeEnd :: Tree Z Complete k v -> k
-  completeEnd (Bottom _ _ _ _ (tk, _tv)) = fromKey tk
+  completeEnd (Bottom _ _ _ (tk, _tv)) = fromKey tk
 
   getEnd :: Tree Z Incomplete k v -> Maybe k
-  getEnd (IBottom0 _ Nothing) =
+  getEnd (IBottom0 Nothing) =
     Nothing
-  getEnd (IBottom0 _ (Just (sk, _v))) =
+  getEnd (IBottom0 (Just (sk, _v))) =
     Just $ unwrap sk
-  getEnd (IBottom1 _ _ (sk, _v) ntmap) =
+  getEnd (IBottom1 _ (sk, _v) ntmap) =
     case Map.toDescList ntmap of
       []       -> Just $ unwrap sk
       (k,_v):_ -> Just $ fromKey k
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
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, LambdaCase, GADTs #-}
 -- |
 -- Module    : Data.StableTree.Conversion
 -- Copyright : Jeremy Groven
@@ -6,41 +6,103 @@
 --
 -- Functions for converting between `Tree` and `Fragment` types
 module Data.StableTree.Conversion
-( toFragments
+( Fragment(..)
+, toFragments
 , fromFragments
 , fragsToMap
 ) where
 
-import Data.StableTree.Properties ( stableChildren )
+import Data.StableTree.Properties ( bottomChildren, branchChildren )
 import Data.StableTree.Build      ( consume, consumeMap )
+import Data.StableTree.Key        ( StableKey )
 import Data.StableTree.Types
 
 import qualified Data.Map as Map
 import qualified Data.Text as Text
-import Data.Map       ( Map )
-import Data.ObjectID  ( ObjectID )
-import Data.Serialize ( Serialize )
-import Data.Text      ( Text )
+import Control.Applicative ( (<$>) )
+import Control.Monad       ( replicateM )
+import Data.Map            ( Map )
+import Data.ObjectID       ( ObjectID, calculateSerialize )
+import Data.Serialize      ( Serialize, get, put )
+import Data.Serialize.Get  ( Get, getByteString )
+import Data.Serialize.Put  ( Put, putByteString )
+import Data.Text           ( Text )
 
+-- |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. 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
+    { fragmentObjectID :: ObjectID
+    , fragmentDepth    :: Depth
+    , fragmentChildren :: Map k (ValueCount, ObjectID)
+    }
+  | FragmentBottom
+    { fragmentObjectID :: ObjectID
+    , fragmentMap      :: Map k v
+    }
+  deriving( Eq, Ord, Show )
+
 -- |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 =
-  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)]
+toFragments :: (Ord k, Serialize k, StableKey k, Serialize v)
+            => StableTree k v -> [Fragment k v]
+toFragments (StableTree_I i) = snd $ toFragments' i
+toFragments (StableTree_C c) = snd $ toFragments' c
 
+-- |Convert a 'Tree' into 'Fragment's. This returns a pair, where the first
+-- element is the 'Fragment' that came directly from the 'Tree', and the second
+-- element is the list of all the 'Fragment's beneath the 'Tree', and the
+-- 'Tree's fragment itself. The list is always sorted lowest to highest, so its
+-- last element is always the same entity as the first element of the pair. 
+toFragments' :: (Ord k, Serialize k, StableKey k, Serialize v)
+             => Tree d c k v -> (Fragment k v, [Fragment k v])
+toFragments' b@(Bottom{})   = bottomToFragments b
+toFragments' b@(IBottom0{}) = bottomToFragments b
+toFragments' b@(IBottom1{}) = bottomToFragments b
+toFragments' b@(Branch{})   = branchToFragments b
+toFragments' b@(IBranch0{}) = branchToFragments b
+toFragments' b@(IBranch1{}) = branchToFragments b
+toFragments' b@(IBranch2{}) = branchToFragments b
+
+-- |Make a Bottom element into a FragmentBottom. Always returns
+-- (fragment, [fragment])
+bottomToFragments :: (Ord k, Serialize k, StableKey k, Serialize v)
+                  => Tree Z c k v -> (Fragment k v, [Fragment k v])
+bottomToFragments tree =
+  let children = bottomChildren tree
+      frag     = fixFragmentID $ FragmentBottom undefined children
+  in (frag, [frag])
+
+-- |Make a Branch into a bunch of Fragments
+branchToFragments :: (Ord k, Serialize k, StableKey k, Serialize v)
+                  => Tree (S d) c k v -> (Fragment k v, [Fragment k v])
+branchToFragments tree =
+  let (completes, mInc) = branchChildren tree
+      compFrags         = Map.map (\(v, t) -> (v, toFragments' t)) completes
+      allFrags          = case mInc of
+                            Nothing ->
+                              compFrags
+                            Just (k, v, t) ->
+                              Map.insert k (v, toFragments' t) compFrags
+      getChildPair     = \(v, (f, _)) -> (v, fragmentObjectID f)
+      children         = Map.map getChildPair allFrags
+      cumulative       = concat $ map (snd . snd) $ Map.elems allFrags
+      depth            = getDepth tree
+      frag             = fixFragmentID $ FragmentBranch undefined depth children
+  in (frag, cumulative ++ [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)
+fromFragments :: (Ord k, Serialize k, StableKey k, Serialize v)
               => Map ObjectID (Fragment k v)
               -> Fragment k v
               -> Either Text (StableTree k v)
@@ -57,8 +119,8 @@
            -> Either Text (Map k v)
 fragsToMap loaded = go Map.empty
   where
-  go accum (FragmentBottom m) = Right $ Map.union accum m
-  go accum (FragmentBranch _ children) =
+  go accum (FragmentBottom _ m) = Right $ Map.union accum m
+  go accum (FragmentBranch _ _ children) =
     go' accum $ map snd $ Map.elems children
 
   go' accum [] = Right accum
@@ -77,12 +139,12 @@
 -- 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)
+fragsToBottoms :: (Ord k, Serialize k, StableKey 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 _ (FragmentBottom _ m) = Right $ consumeMap m
 fragsToBottoms frags top =
   let content = fragmentChildren top
       asList  = Map.toAscList content
@@ -107,4 +169,56 @@
                 Right (completes ++ nxtC, nxtE)
           _ ->
             Left "Got an Incomplete bottom in a non-terminal position"
+
+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" ->
+        get >>= \case
+          0 -> do
+            count <- get
+            children <- Map.fromList <$> replicateM count getPair
+            -- Having to create a broken fragment, serialize it, and then
+            -- calculate that bytestring's ObjectID is gross, when we already
+            -- have the serialized form of the fragment, but I have no idea how
+            -- to access the underlying bytestring. This should be correct, but
+            -- it's not very efficient.
+            return $ fixFragmentID $ FragmentBottom undefined children
+          depth -> do
+            count <- get
+            children <- Map.fromList <$> replicateM count getPair
+            return $ fixFragmentID $ FragmentBranch undefined 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)
+
+-- |Calculate the 'Fragment's 'ObjectID', and patch it into place. This is
+-- generally used to create a 'Fragment', like so:
+--
+-- @
+-- fixFragmentID $ FragmentBottom undefined foo
+-- fixFragmentID $ FragmentBranch undefined foo bar
+-- @
+fixFragmentID :: (Ord k, Serialize k, Serialize v)
+              => Fragment k v -> Fragment k v
+fixFragmentID frag@(FragmentBottom _ children) =
+  FragmentBottom (calculateSerialize frag) children
+fixFragmentID frag@(FragmentBranch _ depth children) =
+  FragmentBranch (calculateSerialize frag) depth children
 
diff --git a/src/Data/StableTree/Key.hs b/src/Data/StableTree/Key.hs
--- a/src/Data/StableTree/Key.hs
+++ b/src/Data/StableTree/Key.hs
@@ -1,5 +1,5 @@
 -- |
--- Module    : Data.StableTree.Types.Key
+-- Module    : Data.StableTree.Key
 -- Copyright : Jeremy Groven
 -- License   : BSD3
 --
@@ -7,17 +7,28 @@
 module Data.StableTree.Key
 ( Key(fromKey)
 , SomeKey(..)
+, StableKey(..)
 , Terminal
 , Nonterminal
 , wrap
 , unwrap
+, hashBs
 ) where
 
+import qualified Data.ByteString.Lazy as LBS
 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 )
+import Data.Int        ( Int8, Int16, Int32, Int64 )
+import Data.IntMap     ( IntMap )
+import Data.IntSet     ( IntSet )
+import Data.Map        ( Map )
+import Data.Ratio      ( Ratio )
+import Data.Sequence   ( Seq )
+import Data.Serialize  ( Serialize, encode )
+import Data.Set        ( Set )
+import Data.Tree       ( Tree )
+import Data.Word       ( Word, Word8, Word16, Word32, Word64 )
 
 -- |Used to indicate that a 'Key' is terminal
 data Terminal
@@ -34,10 +45,16 @@
                | SomeKey_N (Key Nonterminal k)
                deriving ( Eq, Ord, Show )
 
+-- |Type class for 'StableTree' keys
+class StableKey k where
+  -- |Get the "hash" of a key; this is just a single-byte, of which only four
+  -- bits are really used. Just enough to allow one key in 16 to be 'Terminal'
+  hash :: k -> Word8
+
 -- |Do the magic of wrapping up a key into a 'SomeKey'
-wrap :: Serialize k => k -> SomeKey k
+wrap :: StableKey k => k -> SomeKey k
 wrap k =
-  let w8 = byte k
+  let w8 = hash k
       x  = w8 `xor` (w8 `shiftR` 4)
       w4 = x .&. 0xf
   in if w4 == 0xf
@@ -49,11 +66,122 @@
 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
+instance StableKey Bool where
+  hash = hashBs . encode
+
+instance StableKey Char where
+  hash = hashBs . encode
+
+instance StableKey Double where
+  hash = hashBs . encode
+
+instance StableKey Float where
+  hash = hashBs . encode
+
+instance StableKey Int where
+  hash = hashBs . encode
+
+instance StableKey Int8 where
+  hash = hashBs . encode
+
+instance StableKey Int16 where
+  hash = hashBs . encode
+
+instance StableKey Int32 where
+  hash = hashBs . encode
+
+instance StableKey Int64 where
+  hash = hashBs . encode
+
+instance StableKey Integer where
+  hash = hashBs . encode
+
+instance StableKey Ordering where
+  hash = hashBs . encode
+
+instance StableKey Word where
+  hash = hashBs . encode
+
+instance StableKey Word8 where
+  hash = hashBs . encode
+
+instance StableKey Word16 where
+  hash = hashBs . encode
+
+instance StableKey Word32 where
+  hash = hashBs . encode
+
+instance StableKey Word64 where
+  hash = hashBs . encode
+
+instance StableKey ByteString where
+  hash = hashBs . encode
+
+instance StableKey LBS.ByteString where
+  hash = hashBs . encode
+
+instance StableKey IntSet where
+  hash = hashBs . encode
+
+instance Serialize a => StableKey [a] where
+  hash = hashBs . encode
+
+instance (Serialize a, Integral a) => StableKey (Ratio a) where
+  hash = hashBs . encode
+
+instance Serialize a => StableKey (Maybe a) where
+  hash = hashBs . encode
+
+instance Serialize e => StableKey (IntMap e) where
+  hash = hashBs . encode
+
+instance (Ord a, Serialize a) => StableKey (Set a) where
+  hash = hashBs . encode
+
+instance Serialize e => StableKey (Tree e) where
+  hash = hashBs . encode
+
+instance Serialize e => StableKey (Seq e) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b) => StableKey (Either a b) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b) => StableKey (a, b) where
+  hash = hashBs . encode
+
+instance (Ord k, Serialize k, Serialize e) => StableKey (Map k e) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c) => StableKey (a, b, c) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d) => StableKey (a, b, c, d) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e) => StableKey (a, b, c, d, e) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e, Serialize f) => StableKey (a, b, c, d, e, f) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e, Serialize f, Serialize g) => StableKey (a, b, c, d, e, f, g) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e, Serialize f, Serialize g, Serialize h) => StableKey (a, b, c, d, e, f, g, h) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e, Serialize f, Serialize g, Serialize h, Serialize i) => StableKey (a, b, c, d, e, f, g, h, i) where
+  hash = hashBs . encode
+
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e, Serialize f, Serialize g, Serialize h, Serialize i, Serialize j) => StableKey (a, b, c, d, e, f, g, h, i, j) where
+  hash = hashBs . encode
+
+
+-- |Calculate a single-byte hash for a 'ByteString'
+hashBs :: ByteString -> Word8
+hashBs bs =
+  let fnv = fnv1a bs
       w32 = fnv `xor` (fnv `shiftR` 32)
       w16 = w32 `xor` (w32 `shiftR` 16)
       w8  = w16 `xor` (w16 `shiftR` 8)
diff --git a/src/Data/StableTree/Mutate.hs b/src/Data/StableTree/Mutate.hs
--- a/src/Data/StableTree/Mutate.hs
+++ b/src/Data/StableTree/Mutate.hs
@@ -1,31 +1,34 @@
 {-# LANGUAGE LambdaCase, GADTs #-}
+-- |
+-- Module    : Data.StableTree
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- Functions for "updating" StableTrees, in the functional sense. This covers
+-- insertion, deletion, etc.
 module Data.StableTree.Mutate
 ( insert
 , delete
-, fmap
 ) where
 
-import Data.StableTree.Types
 import Data.StableTree.Build      ( consume, consumeBranches', consumeMap, merge )
+import Data.StableTree.Key        ( StableKey )
 import Data.StableTree.Properties ( bottomChildren, selectNode )
+import Data.StableTree.Types
 
 import qualified Data.Map as Map
-import Data.Map       ( Map )
-import Data.Serialize ( Serialize )
-
-import qualified Prelude
-import Prelude hiding ( fmap )
+import Data.Map     ( Map )
 
 -- |Insert a key/value into a 'StableTree'. If the key exists, its existing
 -- value is overwritten.
-insert :: (Ord k, Serialize k, Serialize v)
+insert :: (Ord k, StableKey k)
        => 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)
+delete :: (Ord k, StableKey k)
        => 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
@@ -33,7 +36,7 @@
 -- |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)
+insert' :: (Ord k, StableKey k)
         => k
         -> v
         -> Tree d c k v
@@ -43,7 +46,7 @@
 -- |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)
+delete' :: (Ord k, StableKey k)
         => k
         -> Tree d c k v
         -> ([Tree d Complete k v], Maybe (Tree d Incomplete k v))
@@ -53,22 +56,22 @@
 -- 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)
+mutateBottom :: (Ord k, StableKey k)
              => 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
+    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)
+  mutate :: (Ord k, StableKey k)
          => k
          -> (Map k v -> Map k v)
          -> Tree (S d) c k v
@@ -85,42 +88,4 @@
                                            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
@@ -18,12 +18,13 @@
 , load'
 ) where
 
-import Data.StableTree.Conversion ( toFragments, fromFragments )
-import Data.StableTree.Types      ( StableTree(..), Fragment(..) )
+import Data.StableTree.Conversion ( Fragment(..), toFragments, fromFragments )
+import Data.StableTree.Key        ( StableKey )
+import Data.StableTree.Types      ( StableTree(..) )
 
 import qualified Data.Map as Map
 import Data.ObjectID  ( ObjectID )
-import Data.Serialize ( Serialize(..) )
+import Data.Serialize ( Serialize )
 import Data.Text      ( Text )
 
 -- |Things go wrong with end-user storage, but things can also go wrong with
@@ -41,7 +42,7 @@
 -- 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)
+store :: (Monad m, Error e, Ord k, Serialize k, StableKey k, Serialize v)
       => (a -> ObjectID -> Fragment k v -> m (Either e a))
       -> a
       -> StableTree k v
@@ -49,14 +50,14 @@
 store fn a0 = go a0 . toFragments
   where
   go accum [] = return $ Right accum
-  go accum ((fragid, frag):frags) =
-    fn accum fragid frag >>= \case
+  go accum (frag:frags) =
+    fn accum (fragmentObjectID frag) frag >>= \case
       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)
+store' :: (Monad m, Error e, Ord k, Serialize k, StableKey k, Serialize v)
        => (ObjectID -> Fragment k v -> m (Maybe e))
        -> StableTree k v
        -> m (Either e ObjectID)
@@ -70,7 +71,7 @@
 -- |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)
+load :: (Monad m, Error e, Ord k, Serialize k, StableKey k, Serialize v)
      => (a -> ObjectID -> m (Either e (a, Fragment k v)))
      -> a
      -> ObjectID
@@ -92,7 +93,7 @@
   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 _)) ->
+    Right (accum', frag@(FragmentBottom{})) ->
       recur accum' (Map.insert oid frag frags) rest
     Right (accum', frag) ->
       let children = fragmentChildren frag
@@ -100,7 +101,7 @@
       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)
+load' :: (Monad m, Error e, Ord k, Serialize k, StableKey k, Serialize v)
       => (ObjectID -> m (Either e (Fragment k v)))
       -> ObjectID
       -> m (Either e (StableTree k v))
diff --git a/src/Data/StableTree/Properties.hs b/src/Data/StableTree/Properties.hs
--- a/src/Data/StableTree/Properties.hs
+++ b/src/Data/StableTree/Properties.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GADTs #-}
 -- |
--- Module    : Data.StableTree
+-- Module    : Data.StableTree.Properties
 -- Copyright : Jeremy Groven
 -- License   : BSD3
 --
@@ -34,20 +34,20 @@
 -- |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
+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
+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
@@ -64,13 +64,13 @@
   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
+      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 =
@@ -96,13 +96,13 @@
   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
+      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 =
@@ -118,13 +118,13 @@
 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
+    (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
@@ -158,13 +158,13 @@
                   -> 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
+      (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
@@ -185,18 +185,18 @@
 bottomChildren :: Ord k
                => Tree Z c k v
                -> Map k v
-bottomChildren (Bottom _ (k1,v1) (k2,v2) terms (kt,vt)) =
+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) =
+bottomChildren (IBottom0 Nothing) =
   Map.empty
-bottomChildren (IBottom0 _ (Just (k,v))) =
+bottomChildren (IBottom0 (Just (k,v))) =
   Map.singleton (Key.unwrap k) v
-bottomChildren (IBottom1 _ (k1,v1) (k2,v2) terms) =
+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
@@ -209,19 +209,19 @@
                => 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)) =
+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)) =
+branchChildren (IBranch0 _d (ik,ic,iv)) =
   (Map.empty, Just (Key.unwrap ik, ic, iv))
-branchChildren (IBranch1 _ _d (k1,c1,v1) mIncomplete) =
+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) =
+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)
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
@@ -14,33 +14,14 @@
 , 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.StableTree.Key as Key
+import Data.StableTree.Key      ( StableKey, 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
@@ -118,27 +99,23 @@
 -- 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)
+  Bottom :: (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)
+  IBottom0 :: 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)
+  IBottom1 :: (SomeKey k, v)
            -> (SomeKey k, v)
            -> Map (Key Nonterminal k) v
            -> Tree Z Incomplete k v
 
-  Branch :: ObjectID
-         -> Depth
+  Branch :: 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)
@@ -146,268 +123,159 @@
          -> Tree (S d) Complete k v
 
   -- A strut to lift an incomplete tree to the next level up
-  IBranch0 :: ObjectID
-           -> Depth
+  IBranch0 :: 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
+  IBranch1 :: 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
+  IBranch2 :: 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
+  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 (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,_)) =
+  getValueCount (Branch _ (_,c1,_) (_,c2,_) nterm (_,c3,_)) =
     c1 + c2 + c3 + sum (map fst $ Map.elems nterm)
-  getValueCount (IBranch0 _ _ (_,c,_)) =
+  getValueCount (IBranch0 _ (_,c,_)) =
     c
-  getValueCount (IBranch1 _ _ (_,c,_) Nothing) =
+  getValueCount (IBranch1 _ (_,c,_) Nothing) =
     c
-  getValueCount (IBranch1 _ _ (_,c1,_) (Just (_,c2,_))) =
+  getValueCount (IBranch1 _ (_,c1,_) (Just (_,c2,_))) =
     c1+c2
-  getValueCount (IBranch2 _ _ (_,c1,_) (_,c2,_) m i) =
+  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
+instance (Eq k, Eq v) => Eq (Tree d c k v) where
+  (Bottom lp1 lp2 lnts lt) == (Bottom rp1 rp2 rnts rt) =
+    (lp1 == rp1) && (lp2 == rp2) && (lnts == rnts) && (lt == rt)
+  (IBottom0 l) == (IBottom0 r) = l == r
+  (IBottom1 lp1 lp2 lnts) == (IBottom1 rp1 rp2 rnts) = 
+    (lp1 == rp1) && (lp2 == rp2) && (lnts == rnts)
 
-  makeFragment (StableTree_I t) = makeFragment t
-  makeFragment (StableTree_C t) = makeFragment t
+  -- We _could_ check the depth parameter as well, but that's also in the type
+  -- signature, so why bother?
+  (Branch _ lt1 lt2 lnts lt) == (Branch _ rt1 rt2 rnts rt) =
+    (lt1 == rt1) && (lt2 == rt2) && (lnts == rnts) && (lt == rt)
+  (IBranch0 _ lt) == (IBranch0 _ rt) = lt == rt
+  (IBranch1 _ lt li) == (IBranch1 _ rt ri) = (lt == rt) && (li == ri)
+  (IBranch2 _ lt1 lt2 lnts li) == (IBranch2 _ rt1 rt2 rnts ri) =
+    (lt1 == rt1) && (lt2 == rt2) && (lnts == rnts) && (li == ri)
+  _ == _ = False
 
-instance Eq (Tree d c k v) where
-  t1 == t2 = getObjectID t1 == getObjectID t2
+instance (Eq k, Eq v) => Eq (StableTree k v) where
+  (StableTree_I t1) == (StableTree_I t2) = t1 `equals` t2
+  (StableTree_C t1) == (StableTree_C t2) = t1 `equals` t2
+  _ == _ = False
 
-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
+equals :: (Eq k, Eq v) => Tree d1 c1 k v -> Tree d2 c2 k v -> Bool
+equals l@(Bottom{}) r@(Bottom{})     = l == r
+equals l@(IBottom0{}) r@(IBottom0{}) = l == r
+equals l@(IBottom1{}) r@(IBottom1{}) = l == r
+equals (Branch ld (lk1, lv1, lt1) (lk2, lv2, lt2) lnts (lkt, lvt, ltt))
+       (Branch rd (rk1, rv1, rt1) (rk2, rv2, rt2) rnts (rkt, rvt, rtt)) =
+  (ld == rd) &&
+    (lk1 == rk1) && (lk2 == rk2) && (lkt == rkt) &&
+    (lv1 == rv1) && (lv2 == rv2) && (lvt == rvt) &&
+    (lt1 `equals` rt1) && (lt2 `equals` rt2) && (ltt `equals` rtt) &&
+    (ntEquals lnts rnts)
+equals (IBranch0 ld (lk, lv, lt)) (IBranch0 rd (rk, rv, rt)) =
+  (ld == rd) && (lk == rk) && (lv == rv) && (lt `equals` rt)
+equals (IBranch1 ld (lk, lv, lt) Nothing) (IBranch1 rd (rk, rv, rt) Nothing) =
+  (ld == rd) && (lk == rk) && (lv == rv) && (lt `equals` rt)
+equals (IBranch1 ld (lk, lv, lt) (Just (lki, lvi, lti)))
+       (IBranch1 rd (rk, rv, rt) (Just (rki, rvi, rti))) =
+  (ld == rd) && (lk == rk) && (lv == rv) && (lki == rki) && (lvi == rvi) &&
+    (lt `equals` rt) && (lti `equals` rti)
+equals (IBranch2 ld (lk1, lv1, lt1) (lk2, lv2, lt2) lnts Nothing)
+       (IBranch2 rd (rk1, rv1, rt1) (rk2, rv2, rt2) rnts Nothing) =
+  (ld == rd) &&
+    (lk1 == rk1) && (lk2 == rk2) && (lv1 == rv1) && (lv2 == rv2) &&
+    (lt1 `equals` rt1) && (lt2 `equals` rt2) && (ntEquals lnts rnts)
+equals (IBranch2 ld (lk1, lv1, lt1) (lk2, lv2, lt2) lnts (Just (lki, lvi, lti)))
+       (IBranch2 rd (rk1, rv1, rt1) (rk2, rv2, rt2) rnts (Just (rki, rvi, rti))) =
+  (ld == rd) &&
+    (lk1 == rk1) && (lk2 == rk2) && (lv1 == rv1) && (lv2 == rv2) &&
+    (lki == rki) && (lvi == rvi) && (lti `equals` rti) &&
+    (lt1 `equals` rt1) && (lt2 `equals` rt2) && (ntEquals lnts rnts)
+equals _ _ = False
 
-instance Ord (StableTree k v) where
-  compare l r = compare (getObjectID l) (getObjectID r)
+ntEquals :: (Eq k, Eq v)
+         => Map (Key Nonterminal k) (ValueCount, Tree d1 Complete k v)
+         -> Map (Key Nonterminal k) (ValueCount, Tree d2 Complete k v)
+         -> Bool
+ntEquals lnts rnts =
+  (Map.keys lnts == Map.keys rnts) &&
+    (map fst (Map.elems lnts) == map fst (Map.elems rnts)) &&
+    (all (==True) (zipWith (\l r -> (snd l) `equals` (snd r))
+                           (Map.elems lnts)
+                           (Map.elems rnts)))
 
 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)
+instance (Ord k, StableKey k) => Functor (Tree d c k) where
+  fmap fn (Bottom (k1, v1) (k2, v2) nonterms (kt, vt)) =
+    Bottom (k1, fn v1) (k2, fn v2) (Map.map fn nonterms) (kt, fn vt)
+  fmap fn (IBottom0 mpair) =
+    IBottom0 (Prelude.fmap (\(k,v) -> (k, fn v)) mpair)
+  fmap fn (IBottom1 (k1, v1) (k2, v2) nonterms) =
+    IBottom1 (k1, fn v1) (k2, fn v2) (Map.map fn nonterms)
+  fmap fn (Branch d (k1, c1, t1) (k2, c2, t2) nonterms (kt, ct, tt)) =
+    Branch 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)) =
+    IBranch0 d
+               (k1, c1, fmap fn t1)
+  fmap fn (IBranch1 d (k1, c1, t1) mtriple) =
+    IBranch1 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) =
+    IBranch2 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)
 
-  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)
+instance (Ord k, StableKey k) => Functor (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/Walk.hs b/src/Data/StableTree/Walk.hs
--- a/src/Data/StableTree/Walk.hs
+++ b/src/Data/StableTree/Walk.hs
@@ -34,13 +34,13 @@
          => (a -> k -> v -> m a) -> a -> Tree d c k v -> m a
   foldM' f accum t =
     case t of
-      Bottom _ _ _ _ _     -> bottom f accum t
-      IBottom0 _ _         -> bottom f accum t
-      IBottom1 _ _ _ _     -> bottom f accum t
-      Branch _ _ _ _ _ _   -> branch f accum t
-      IBranch0 _ _ _       -> branch f accum t
-      IBranch1 _ _ _ _     -> branch f accum t
-      IBranch2 _ _ _ _ _ _ -> branch f accum t
+      Bottom _ _ _ _     -> bottom f accum t
+      IBottom0 _         -> bottom f accum t
+      IBottom1 _ _ _     -> bottom f accum t
+      Branch _ _ _ _ _   -> branch f accum t
+      IBranch0 _ _       -> branch f accum t
+      IBranch1 _ _ _     -> branch f accum t
+      IBranch2 _ _ _ _ _ -> branch f accum t
 
   bottom :: (Monad m, Ord k)
          => (a -> k -> v -> m a) -> a -> Tree Z c k v -> m a
@@ -70,13 +70,13 @@
   foldr' :: Ord k => (k -> v -> a -> a) -> a -> Tree d c k v -> a
   foldr' f accum t =
     case t of
-      Bottom _ _ _ _ _     -> bottom f accum t
-      IBottom0 _ _         -> bottom f accum t
-      IBottom1 _ _ _ _     -> bottom f accum t
-      Branch _ _ _ _ _ _   -> branch f accum t
-      IBranch0 _ _ _       -> branch f accum t
-      IBranch1 _ _ _ _     -> branch f accum t
-      IBranch2 _ _ _ _ _ _ -> branch f accum t
+      Bottom _ _ _ _     -> bottom f accum t
+      IBottom0 _         -> bottom f accum t
+      IBottom1 _ _ _     -> bottom f accum t
+      Branch _ _ _ _ _   -> branch f accum t
+      IBranch0 _ _       -> branch f accum t
+      IBranch1 _ _ _     -> branch f accum t
+      IBranch2 _ _ _ _ _ -> branch f accum t
 
   bottom :: Ord k => (k -> v -> a -> a) -> a -> Tree Z c k v -> a
   bottom f accum t =
@@ -105,13 +105,13 @@
   foldl' :: Ord k => (a -> k -> v -> a) -> a -> Tree d c k v -> a
   foldl' f accum t =
     case t of
-      Bottom _ _ _ _ _     -> bottom f accum t
-      IBottom0 _ _         -> bottom f accum t
-      IBottom1 _ _ _ _     -> bottom f accum t
-      Branch _ _ _ _ _ _   -> branch f accum t
-      IBranch0 _ _ _       -> branch f accum t
-      IBranch1 _ _ _ _     -> branch f accum t
-      IBranch2 _ _ _ _ _ _ -> branch f accum t
+      Bottom _ _ _ _     -> bottom f accum t
+      IBottom0 _         -> bottom f accum t
+      IBottom1 _ _ _     -> bottom f accum t
+      Branch _ _ _ _ _   -> branch f accum t
+      IBranch0 _ _       -> branch f accum t
+      IBranch1 _ _ _     -> branch f accum t
+      IBranch2 _ _ _ _ _ -> branch f accum t
 
   bottom :: Ord k => (a -> k -> v -> a) -> a -> Tree Z c k v -> a
   bottom f accum t =
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.6.1
+version:             0.7.0
 synopsis:            Trees whose branches are resistant to change
 -- description:         
 homepage:            https://github.com/tsuraan/stable-tree
@@ -51,7 +51,7 @@
                      , text
   hs-source-dirs:      src
   default-language:    Haskell2010
-  ghc-options:         -Wall -fllvm
+  ghc-options:         -Wall -fllvm -fno-max-relevant-binds
 
 test-suite test-all
   type:                exitcode-stdio-1.0
diff --git a/tests/TestAll.hs b/tests/TestAll.hs
--- a/tests/TestAll.hs
+++ b/tests/TestAll.hs
@@ -7,6 +7,7 @@
 import qualified Data.StableTree.Persist as SP
 import Data.StableTree ( StableTree )
 import Data.StableTree.Persist ( Fragment(..), Error(..) )
+import Data.StableTree.Key     ( StableKey )
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -86,7 +87,8 @@
       Just v' | v' == v -> test_lookup rest t
       _ -> False
 
-  test_delete :: (Show k, Ord k, Serialize k, Show v, Serialize v)
+  test_delete :: ( Eq k, Show k, Ord k, Serialize k, StableKey k
+                 , Eq v, Show v, Serialize v)
               => [(k,v)]
               -> Gen Bool
   test_delete [] = return True
@@ -98,7 +100,8 @@
         s' = ST.delete delkey s
     return (s' == ST.fromMap m')
 
-  test_insert :: (Show k, Ord k, Serialize k, Show v, Serialize v)
+  test_insert :: ( Eq k, Show k, Ord k, Serialize k, StableKey k
+                 , Eq v, Show v, Serialize v)
               => [(k,v)]
               -> Gen Bool
   test_insert [] = return True
@@ -111,7 +114,8 @@
         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)
+  test_mutate :: ( Arbitrary k, Eq k, Show k, Ord k, Serialize k, StableKey k
+                 , Arbitrary v, Eq v, Show v, Serialize v)
               => StableTree k v
               -> Gen Bool
   test_mutate tree | ST.size tree == 0 = return True
@@ -144,7 +148,8 @@
   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 :: (Eq k, Ord k, Serialize k, StableKey k, Eq v, Serialize v)
+         => [(k,v)] -> Bool
   action pairs = fst $ runState go Map.empty
     where
     go = do
@@ -165,13 +170,13 @@
 
 type StableTreeState = State (Map ByteString ByteString)
 
-store :: (Ord k, Serialize k, Serialize v)
+store :: (Ord k, Serialize k, StableKey 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)
+load :: (Ord k, Serialize k, StableKey k, Serialize v)
      => ObjectID -> StableTreeState (Either RamError (Fragment k v))
 load oid =
   gets (Map.lookup $ encode oid) >>= \case