diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, jay groven
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of jay groven nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/demo/Main.hs b/demo/Main.hs
new file mode 100644
--- /dev/null
+++ b/demo/Main.hs
@@ -0,0 +1,63 @@
+-- |A small demo program to demonstrate how stable trees behave compared with
+-- how one might naively implement versioned trees in a relational database.
+-- More detailed explanation of the naive storage is in the stupidCount
+-- function.
+module Main
+( main
+) where
+
+import Data.StableTree        ( fromMap )
+import Data.StableTree.IO     ( store )
+import Data.StableTree.IO.Ram ( storage )
+
+import qualified Data.Map as Map
+import Data.IORef ( readIORef )
+
+-- |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 = do
+  (s, trees, values) <- storage
+  mapM_ (doRun s trees) [0,100..1000::Int]
+  store s (fromMap $ Map.fromList [(a,a+1)|a<-[100..1000]])
+  prTrees trees
+  store s (fromMap $ Map.fromList [(a,a+1)|a<-[200..1000]])
+  prTrees trees
+  store s (fromMap $ Map.fromList [(a,a+1)|a<-[0..400]++[600..1000]])
+  prTrees trees
+
+  where
+  doRun s trees i = do
+    mapM_ (upd s) [i..i+100]
+    putStr $ stupidCount (i+100) ++ " "
+    prTrees trees
+
+  upd s i = do
+    let m = Map.fromList [(a,a+1) | a <- [0..i]]
+        t = fromMap m
+    store s t
+
+  prTrees trees = 
+    readIORef trees >>= return . length . Map.keys >>= print
+
+-- |The typical way of storing key/value maps in SQL is to use a relational
+-- table, like this:
+--
+-- @
+-- CREATE TABLE Trees ( id serial primary key, name text );
+-- CREATE TABLE Values ( id serial primary key, value bytea );
+-- CREATE TABLE tree_entries ( tree_id integer references trees
+--                           , value_id integer references values
+--                           , name text
+--                           , unique(tree_id, name)
+--                           );
+-- @
+--
+-- Using this strategy works poorly when trees are related, such as when doing
+-- version control on a set of directories. In that case, supposing one were to
+-- make a new version every time a file were added to a directory, the size of
+-- tree_entries grows as the square of the size of trees. This function does
+-- that calculation.
+stupidCount :: Int -> String
+stupidCount i = show $ i*(i-1) `div` 2
diff --git a/src/Data/StableTree.hs b/src/Data/StableTree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree.hs
@@ -0,0 +1,77 @@
+-- |
+-- Module    : Data.StableTree
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- A Rose Tree designed for maximal stability under mutation. The StableTree
+-- structure is meant to be used in places where different versions of a
+-- key/value map are kept, such as in a versioning file system or a revision
+-- control system. As a tree's contents are mutated (inserted, updated,
+-- deleted), it will tend to keep the vast majority of its branches untouched,
+-- with generally just the immediate branch and its immediate ancestor chain
+-- being modified. Put another way, trees with similar contents will also share
+-- a majority of their branches.
+--
+-- This module exports the public interface for StableTree. Right now, that's
+-- just a translation to the standard Data.Map and back. There's nothing about
+-- StableTree that forbids direct manipulation, but I've been playing with
+-- various implementations of this for way too long, and I just want to start
+-- using the dang thing now.
+module Data.StableTree
+( StableTree(..)
+, IsKey(..)
+, fromMap
+, toMap
+) where
+
+import Data.StableTree.Types
+
+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)
+
+-- | Convert a 'Data.Map.Map' into a 'StableTree'.
+fromMap :: (Ord k, IsKey k) => Map k v -> StableTree k v
+fromMap m = go m Map.empty
+  where
+  go values accum =
+    case nextBottom values of
+      Left incomplete ->
+        if Map.null accum
+          then StableTree_I incomplete
+          else case 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
+
+  buildParents completes mIncomplete accum =
+    case nextBranch completes mIncomplete of
+      Left incomplete ->
+        if Map.null accum
+          then StableTree_I incomplete
+          else case 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
+            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
+
+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/IO.hs b/src/Data/StableTree/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/IO.hs
@@ -0,0 +1,285 @@
+{-# LANGUAGE LambdaCase, OverloadedStrings #-}
+-- |
+-- Module    : Data.StableTree.IO
+-- Copyright : Jeremy Groven
+-- License   : BSD3
+--
+-- Logic for dealing with the actual storage of Stable Trees. The key exports
+-- here are 'Error', 'Store', 'load', and 'store'. A user needs to implement
+-- the 'loadTree', 'loadValue', 'storeTree' and 'storeValue' parts of 'Store',
+-- and make an appropriate Error type to report storage errors, and then the
+-- 'load' and 'store' functions can just do their thing. If necessary, a user
+-- can also implement 'Build' for custom data types.
+module Data.StableTree.IO
+( Store(..)
+, Build(..)
+, Error(..)
+, Id
+, load
+, store
+, buildBinary
+, buildSerialize
+) where
+
+import Data.StableTree.Types hiding ( hash )
+import Data.StableTree ( 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, liftIO, throwError )
+import Crypto.Hash.Tsuraan.Blake2          ( 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 )
+
+-- |Things go wrong with end-user storage, but things can also go wrong with
+-- reconstructing tree values. Implement 'stableTreeError' to allow 'load' and
+-- 'store' to report their own errors.
+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 )
+
+-- |Write appropriate functions here to load and store primitive parts of
+-- trees.
+data Store e k v = Store
+  { loadTree   :: Id -> IO (Either e (Int, Map k Id))
+  , loadValue  :: Id -> IO (Either e v)
+  , storeTree  :: Id -> Int -> Map k Id -> IO (Maybe e)
+  , storeValue :: Id -> v -> IO (Maybe e)
+  }
+
+-- |Retrieve a tree given its id.
+load :: (IsKey k, Ord k, Error e) => Store e k v -> Id -> IO (Either e (StableTree k v))
+load s i = runExceptT $ load' s i
+
+load' :: (IsKey k, Ord k, Error e) => Store e k v -> Id -> ExceptT e IO (StableTree k v)
+load' storage treeId =
+  liftEitherIO (loadTree storage treeId) >>= \case
+    (0, contents)     -> loadBottom contents
+    (depth, contents) -> loadBranch depth contents
+  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 <- liftEitherIO $ 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 :: (Build k, Ord k, Build v)
+      => Store e k v
+      -> StableTree k v
+      -> IO (Either e Id)
+store storage (StableTree_I i) = runExceptT $ store' storage i
+store storage (StableTree_C c) = runExceptT $ store' storage c
+
+store' :: (Build k, Ord k, Build v)
+       => Store e k v
+       -> Tree c k v
+       -> ExceptT e IO Id
+store' storage tree =
+  case branchContents tree of
+    Left subtrees -> storeBranch subtrees
+    Right kvmap -> storeBottom kvmap
+
+  where
+  storeBranch (complete, mIncomplete) = do
+    key_ids <- storeSubtrees complete Map.empty
+    case mIncomplete of
+      Nothing -> storeKeyIds key_ids
+      Just (k,v) -> do
+        treeId <- store' storage v
+        storeKeyIds $ Map.insert k treeId key_ids
+
+  storeSubtrees kvmap accum =
+    case Map.minViewWithKey kvmap of
+      Nothing -> return accum
+      Just ((k,t), rest) -> do
+        treeId <- store' storage t
+        storeSubtrees rest $ Map.insert k 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
+        _ <- liftMaybeIO $ storeValue storage valId v
+        storeValues rest $ Map.insert k valId accum
+
+  storeKeyIds key_ids =
+    let depth = getDepth tree
+        valId = treeHash depth key_ids
+    in do liftMaybeIO $ 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
+
+calcId :: Builder -> Id
+calcId = right . runGet get . hash 32 . toByteString
+  where
+  right ei =
+    case ei of
+      Left _ -> error "Got a left!?"
+      Right v -> v
+
+  get = do
+    a <- getWord64be
+    b <- getWord64be
+    c <- getWord64be
+    d <- getWord64be
+    return $ Id a b c d
+
+liftEitherIO :: IO (Either a b) -> ExceptT a IO b
+liftEitherIO act =
+  liftIO act >>= \case
+    Left err -> throwError err
+    Right val -> return val
+
+liftMaybeIO :: IO (Maybe e) -> ExceptT e IO ()
+liftMaybeIO act =
+  liftIO 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
+
diff --git a/src/Data/StableTree/IO/Ram.hs b/src/Data/StableTree/IO/Ram.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/IO/Ram.hs
@@ -0,0 +1,58 @@
+-- |
+-- Module    : Data.StableTree.IO.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.IO.Ram
+( RamError(..)
+, storage
+) where
+
+import Data.StableTree.IO ( 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 = NoKey
+              | ApiError Text
+              deriving ( Show )
+
+instance Error RamError where
+  stableTreeError = ApiError
+
+-- |Create a new RAM store
+storage :: IO ( Store RamError k v
+              , IORef (Map Id (Int,Map k 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 NoKey
+      Just pair -> return $ Right pair
+
+  lv store vid = do
+    m <- readIORef store
+    case Map.lookup vid m of
+      Nothing -> return $ Left NoKey
+      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
+    modifyIORef store $ Map.insert vid val
+    return Nothing
+
diff --git a/src/Data/StableTree/Types.hs b/src/Data/StableTree/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Types.hs
@@ -0,0 +1,319 @@
+{-# 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.
+module Data.StableTree.Types
+( IsKey(..)
+, Tree(..)
+, Complete
+, Incomplete
+, nextBottom
+, nextBranch
+, getKey
+, completeKey
+, treeContents
+, branchContents
+, getDepth
+) 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   
+
+-- |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 :: Int
+         -> (SomeKey k, Tree Complete k v)
+         -> (SomeKey k, Tree Complete k v)
+         -> Map (Key Nonterminal k) (Tree Complete k v)
+         -> (Key Terminal k, 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 :: Int
+           -> (SomeKey k, Tree Incomplete k v)
+           -> Tree Incomplete k v
+
+  -- A joining of a single complete and maybe an incomplete
+  IBranch1 :: Int
+           -> (SomeKey k, Tree Complete k v)
+           -> Maybe (SomeKey k, Tree Incomplete k v)
+           -> Tree Incomplete k v
+
+  -- A branch that doesn't have a terminal, and that might have an IBranch
+  IBranch2 :: Int
+           -> (SomeKey k, Tree Complete k v)
+           -> (SomeKey k, Tree Complete k v)
+           -> Map (Key Nonterminal k) (Tree Complete k v)
+           -> Maybe (SomeKey k, 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, iv)
+    Just ((k,v), Nothing) ->
+      Left $ IBranch1 depth (wrap k,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,v), remain') ->
+        Right ( Branch depth f1 f2 accum (term, v), remain' )
+      Just ((SomeKey_N nonterm,v), remain') ->
+        go f1 f2 (Map.insert nonterm v accum) remain'
+
+  wrapKey :: IsKey k => (k,v) -> (SomeKey k, v)
+  wrapKey = first wrap
+
+  wrapMKey :: IsKey k => Maybe (k,v) -> Maybe (SomeKey k, 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 (Branch _ (k,_) _ _ _)   = Just $ unwrap k
+getKey (IBottom0 Nothing)       = Nothing
+getKey (IBottom0 (Just (k,_)))  = Just $ unwrap k
+getKey (IBottom1 (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 $ Map.elems completes
+    Left ( completes, Just (_k, iv)) ->
+      Map.unions $ treeContents iv:map treeContents (Map.elems completes)
+    Right x -> x
+
+-- |Get the number of levels of branches that live below this one
+getDepth :: Tree c k v -> Int
+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
+
+-- |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 (Tree Complete k v)
+                         , Maybe (k, 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,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 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 incomplete) =
+  Left (Map.empty, Just $ first unwrap incomplete)
+branchContents (IBranch1 _d (k1,v1) mIncomplete) =
+  Left (Map.singleton (unwrap k1) v1, mIncomplete >>= return . first unwrap)
+branchContents (IBranch2 _d (k1,v1) (k2,v2) terms mIncomplete) =
+  let terms' = Map.mapKeys fromKey terms
+      conts  = Map.insert (unwrap k1) v1
+             $ Map.insert (unwrap k2) v2
+             terms'
+  in Left (conts, mIncomplete >>= return . first unwrap)
+
+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, 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
new file mode 100644
--- /dev/null
+++ b/src/Data/StableTree/Types/Key.hs
@@ -0,0 +1,146 @@
+-- |
+-- 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
new file mode 100644
--- /dev/null
+++ b/stable-tree.cabal
@@ -0,0 +1,60 @@
+-- Initial stable-tree.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                stable-tree
+version:             0.0.1
+synopsis:            Trees whose branches are resistant to change
+-- description:         
+homepage:            https://github.com/tsuraan/stable-tree
+license:             BSD3
+license-file:        LICENSE
+author:              jay groven
+maintainer:          tsuraan@gmail.com
+-- copyright:           
+category:            Data
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+executable demo
+  build-depends:       base >=4.6 && <4.8
+                     , containers
+                     , stable-tree
+  hs-source-dirs:      demo
+  main-is:             Main.hs
+  default-language:    Haskell2010
+
+library
+  exposed-modules:     Data.StableTree
+                     , Data.StableTree.Types
+                     , Data.StableTree.Types.Key
+                     , Data.StableTree.IO
+                     , Data.StableTree.IO.Ram
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.6 && <4.8
+                     , binary
+                     , blaze-builder
+                     , bytestring
+                     , cereal
+                     , containers
+                     , hs-blake2
+                     , mtl
+                     , text
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fllvm
+
+test-suite test-all
+  type:                exitcode-stdio-1.0
+  main-is:             TestAll.hs
+  build-depends:       base >=4.6 && < 4.8
+                     , bytestring-arbitrary
+                     , containers
+                     , QuickCheck
+                     , stable-tree
+                     , tasty
+                     , tasty-quickcheck
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -Wall
diff --git a/tests/TestAll.hs b/tests/TestAll.hs
new file mode 100644
--- /dev/null
+++ b/tests/TestAll.hs
@@ -0,0 +1,77 @@
+module Main
+( main
+) where
+
+import qualified Data.StableTree as ST
+import Data.StableTree.IO ( store, load )
+import Data.StableTree.IO.Ram ( storage )
+
+import qualified Data.Map as Map
+import Control.Arrow ( first )
+import Data.ByteString.Arbitrary ( ArbByteString(..) )
+import Test.Tasty
+import Test.Tasty.QuickCheck ( testProperty )
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+
+main :: IO ()
+main = defaultMain $
+  testGroup "StableTree"
+  [ testGroup "Pure"
+    [ testProperty "Int/Int" int_int
+    , testProperty "Float/Int" float_int
+    , testProperty "ByteString/Int" bytestring_int
+    ]
+  , testGroup "Stored"
+    [ testProperty "Int/Int" store_int_int
+    , testProperty "Float/Int" store_float_int
+    , testProperty "ByteString/Int" store_bytestring_int
+    ]
+  ]
+  where
+
+  int_int :: [(Int,Int)] -> Bool
+  int_int pairs =
+    let m = Map.fromList pairs
+        st = ST.fromMap m
+    in m == ST.toMap st
+
+  float_int :: [(Float,Int)] -> Bool
+  float_int pairs =
+    let m = Map.fromList pairs
+        st = ST.fromMap m
+    in m == ST.toMap st
+
+  bytestring_int :: [(ArbByteString,Int)] -> Bool
+  bytestring_int pairs =
+    let m = Map.fromList $ map (first fromABS) pairs
+        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_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_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'
+