diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
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/benchmarks/src/01.hs b/benchmarks/src/01.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/src/01.hs
@@ -0,0 +1,447 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP   #-}
+
+module Main
+( main
+) where
+
+--------------------------------------------------------------------------------
+import           Control.DeepSeq (NFData(..))
+import           Control.Exception.Base (evaluate)
+import           Control.Monad.Trans (liftIO)
+--------------------------------------------------------------------------------
+import           Data.List
+import qualified Data.Map.Strict as Data.Map
+--------------------------------------------------------------------------------
+import qualified Criterion.Config as C
+import qualified Criterion.Main   as C
+--------------------------------------------------------------------------------
+import qualified DS.B01
+import qualified TS.B01
+import qualified IS.B01
+--------------------------------------------------------------------------------
+import Common
+--------------------------------------------------------------------------------
+
+#define BENCH_SMALL
+#define BENCH_ESSENTIALS
+
+data RNF where
+    RNF :: NFData a => a -> RNF
+
+instance NFData RNF where
+    rnf (RNF x) = rnf x
+
+main :: IO ()
+main = C.defaultMainWith C.defaultConfig (liftIO . evaluate $ rnf
+  [ RNF elems500
+  , RNF elems10000
+  , RNF elems20000
+#ifndef BENCH_SMALL
+  , RNF elems100000
+  , RNF elems200000
+  , RNF elems400000
+  , RNF elems800000
+#endif
+
+  , RNF elems5000x5000
+  , RNF elems10000x5000
+
+  , RNF ds10000
+  , RNF ds20000
+#ifndef BENCH_SMALL
+  , RNF ds100000
+  , RNF ds200000
+  --, RNF ds400000
+  --, RNF ds800000
+#endif
+
+  , RNF map10000
+  , RNF map20000
+#ifndef BENCH_SMALL
+  , RNF map100000
+  , RNF map200000
+  --, RNF map400000
+  --, RNF map800000
+#endif
+  
+  , RNF is10000
+  , RNF is20000
+#ifndef BENCH_SMALL
+  , RNF is100000
+  , RNF is200000
+#endif
+  
+  , RNF ts10000
+  , RNF ts20000
+#ifndef BENCH_SMALL
+  , RNF ts100000
+  , RNF ts200000
+#endif
+
+  , RNF elem9999999
+  , RNF elem2500
+  ])
+  -- Insert 1 element into a store of size N. No collisions.
+  [ {-
+    C.bgroup "insert (Int) 01 10000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem9999999) ds10000
+      , C.bench "DS (Unsafe)" $ C.nf (DS.B01.insertUnsafe elem9999999) ds10000
+#ifndef BENCH_DS
+      , C.bench "Map" $ C.whnf (insertMap elem9999999) map10000
+      , C.bench "IS" $ C.nf (IS.B01.insert elem9999999) is10000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem9999999) ts10000
+#endif
+      ]
+    ]
+  , C.bgroup "insert (Int) 01 20000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem9999999) ds20000
+      , C.bench "DS (Unsafe)" $ C.nf (DS.B01.insertUnsafe elem9999999) ds20000
+#ifndef BENCH_DS
+      , C.bench "Map" $ C.whnf (insertMap elem9999999) map20000
+      , C.bench "IS" $ C.nf (IS.B01.insert elem9999999) is20000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem9999999) ts20000
+#endif
+      ]
+    ]
+  , C.bgroup "insert-collision (Int) 01 10000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem2500) ds10000
+#ifndef BENCH_DS
+      , C.bench "Map" $ C.whnf (insertMap elem2500) map10000
+      , C.bench "IS" $ C.nf (IS.B01.insert elem2500) is10000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem2500) ts10000
+#endif
+      ]
+    ]
+  , C.bgroup "insert-collision (Int) 01 20000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem2500) ds20000
+#ifndef BENCH_DS
+      , C.bench "Map" $ C.whnf (insertMap elem2500) map20000
+      , C.bench "IS" $ C.nf (IS.B01.insert elem2500) is20000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem2500) ts20000
+#endif
+      ]
+    ]
+  -}
+    C.bgroup "lookup OO EQ (Int) 01 20000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOOEQ 10000) ds20000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOOEQLens 10000) ds20000
+#ifndef BENCH_DS
+      , C.bench "Map" $ C.nf (Data.Map.lookup 10000) map20000
+      , C.bench "IS" $ C.nf (IS.B01.lookupOOEQ 10000) is20000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOOEQ 10000) ts20000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OO GE (Int) 01 20000 (500)"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOOGE 19500) ds20000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOOGELens 19500) ds20000
+      , C.bench "DS (Test)" $ C.nf (insertListDSUnsafe elems500) DS.B01.empty
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOOGE 19500) is20000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOOGE 19500) ts20000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OM EQ (Int) 01 20000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOMEQ 200) ds20000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOMEQLens 200) ds20000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOMEQ 200) is20000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOMEQ 200) ts20000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OM GE (Int) 01 20000 (500)"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOMGE 3900) ds20000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOMGELens 3900) ds20000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOMGE 3900) is20000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOMGE 3900) ts20000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup MM EQ (Int) 01 20000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupMMEQ 200) ds20000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupMMEQLens 200) ds20000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupMMEQ 200) is20000
+      , C.bench "TS" $ C.nf (TS.B01.lookupMMEQ 200) ts20000
+#endif
+      ]
+    ]
+
+  -- BIG INPUTS
+  -- Insert 1 element into a store of size N. No collisions.
+#ifndef BENCH_SMALL 
+  , C.bgroup "insert (Int) 01 100000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem9999999) ds100000
+      , C.bench "DS (Unsafe)" $ C.nf (DS.B01.insertUnsafe elem9999999) ds100000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.insert elem9999999) is100000
+      , C.bench "Map" $ C.whnf (insertMap elem9999999) map100000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem9999999) ts100000
+#endif
+      ]
+    ]
+  , C.bgroup "insert (Int) 01 200000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem9999999) ds200000
+      , C.bench "DS (Unsafe)" $ C.whnf (DS.B01.insertUnsafe elem9999999) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.insert elem9999999) is200000
+      , C.bench "Map" $ C.whnf (insertMap elem9999999) map200000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem9999999) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "insert-collision (Int) 01 100000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem2500) ds100000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.whnf (IS.B01.insert elem2500) is100000
+      , C.bench "Map" $ C.nf (insertMap elem2500) map100000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem2500) ts100000
+#endif
+      ]
+    ]
+  , C.bgroup "insert-collision (Int) 01 200000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.insert elem2500) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.insert elem2500) is200000
+      , C.bench "Map" $ C.nf (insertMap elem2500) map200000
+      , C.bench "TS" $ C.nf (TS.B01.insert elem2500) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OO EQ (Int) 01 200000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOOEQ 2500) ds200000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOOEQLens 2500) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOOEQ 2500) is200000
+      , C.bench "Map" $ C.whnf (Data.Map.lookup 2500) map200000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOOEQ 2500) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OO GE (Int) 01 200000 (500)"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOOGE 199000) ds200000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOOGELens 199000) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOOGE 199000) is200000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOOGE 199500) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OM EQ (Int) 01 200000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOMEQ 200) ds200000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOMEQLens 200) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOMEQ 200) is200000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOMEQ 200) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup OM GE (Int) 01 200000 (500)"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupOMGE 39900) ds200000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupOMGELens 39900) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupOMGE 39900) is200000
+      , C.bench "TS" $ C.nf (TS.B01.lookupOMGE 39900) ts200000
+#endif
+      ]
+    ]
+  , C.bgroup "lookup MM EQ (Int) 01 200000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (DS.B01.lookupMMEQ 200) ds200000
+      , C.bench "DS (Lens)" $ C.nf (DS.B01.lookupMMEQLens 200) ds200000
+#ifndef BENCH_DS
+      , C.bench "IS" $ C.nf (IS.B01.lookupMMEQ 200) is200000
+      , C.bench "TS" $ C.nf (TS.B01.lookupMMEQ 200) ts200000
+#endif
+      ]
+    ]
+-- BENCH_SMALL
+#endif
+
+{-
+#ifndef BENCH_ESSENTIALS
+  -- Insert N elements into an empty store (the inserts are accumulative). No collisions.
+  , C.bgroup "insert-accum (Int) 01 10000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (insertListDS elems10000) DS.B01.empty
+      , C.bench "DS (Unsafe)" $ C.nf (insertListDSUnsafe elems10000) DS.B01.empty
+#ifndef BENCH_DS
+      , C.bench "TS" $ C.nf (insertListTS elems10000) TS.B01.empty
+#endif
+      ]
+    ]
+  
+  -- Insert N elements into store of the same N elements (the inserts are
+  -- accumulative, thus we basically "overwrite" the shole store).
+  -- Collisions (obviously).
+    , C.bgroup "insert-accum-collisions (Int) 01 10000"
+    [ C.bcompare
+      [ C.bench "DS" $ C.nf (insertListDS elems10000) ds10000
+#ifndef BENCH_DS      
+      , C.bench "TS" $ C.nf (insertListTS elems10000) ts10000
+#endif
+      ]
+    ]
+-- ESSENTIALS
+#endif
+-}
+  ]
+
+
+---
+
+insertListDS :: [C01] -> DS.B01.DS -> DS.B01.DS
+insertListDS xs s0 = foldl' (flip DS.B01.insert) s0 xs
+
+insertListDSUnsafe :: [C01] -> DS.B01.DS -> DS.B01.DS
+insertListDSUnsafe xs s0 = foldl' (flip DS.B01.insertUnsafe) s0 xs
+
+insertListTS :: [C01] -> TS.B01.TS -> TS.B01.TS
+insertListTS xs s0 = foldl' (flip TS.B01.insert) s0 xs
+
+insertListIS :: [C01] -> IS.B01.IS -> IS.B01.IS
+insertListIS xs s0 = foldl' (\s x -> IS.B01.insert x $! s) s0 xs
+
+insertListMap :: [C01] -> Data.Map.Map Int C01 -> Data.Map.Map Int C01
+insertListMap xs s0 = foldl' (flip insertMap) s0 xs
+
+insertMap :: C01 -> Data.Map.Map Int C01 -> Data.Map.Map Int C01
+insertMap x@(C01 oo _ _) = Data.Map.insert oo x
+
+-- MAP
+
+map10000 :: Data.Map.Map Int C01
+map10000 = insertListMap elems10000 Data.Map.empty
+
+map20000 :: Data.Map.Map Int C01
+map20000 = insertListMap elems20000 Data.Map.empty
+
+#ifndef BENCH_SMALL
+map100000 :: Data.Map.Map Int C01
+map100000 = insertListMap elems100000 Data.Map.empty
+
+map200000 :: Data.Map.Map Int C01
+map200000 = insertListMap elems200000 Data.Map.empty
+
+map800000 :: Data.Map.Map Int C01
+map800000 = insertListMap elems800000 Data.Map.empty
+#endif
+
+-- IS
+
+is10000 :: IS.B01.IS
+is10000 = insertListIS elems10000 IS.B01.empty
+
+is20000 :: IS.B01.IS
+is20000 = insertListIS elems20000 IS.B01.empty
+
+#ifndef BENCH_SMALL
+is100000 :: IS.B01.IS
+is100000 = insertListIS elems100000 IS.B01.empty
+
+is200000 :: IS.B01.IS
+is200000 = insertListIS elems200000 IS.B01.empty
+#endif
+
+-- DS
+
+ds10000 :: DS.B01.DS
+ds10000 = insertListDS elems10000 DS.B01.empty
+
+ds20000 :: DS.B01.DS
+ds20000 = insertListDS elems20000 DS.B01.empty
+
+#ifndef BENCH_SMALL
+ds100000 :: DS.B01.DS
+ds100000 = insertListDS elems100000 DS.B01.empty
+
+ds200000 :: DS.B01.DS
+ds200000 = insertListDS elems200000 DS.B01.empty
+
+ds400000 :: DS.B01.DS
+ds400000 = insertListDS elems400000 DS.B01.empty
+
+ds800000 :: DS.B01.DS
+ds800000 = insertListDS elems800000 DS.B01.empty
+#endif
+
+-- TS
+
+ts10000 :: TS.B01.TS
+ts10000 = insertListTS elems10000 TS.B01.empty
+
+ts20000 :: TS.B01.TS
+ts20000 = insertListTS elems20000 TS.B01.empty
+
+#ifndef BENCH_SMALL
+ts100000 :: TS.B01.TS
+ts100000 = insertListTS elems100000 TS.B01.empty
+
+ts200000 :: TS.B01.TS
+ts200000 = insertListTS elems200000 TS.B01.empty
+#endif
+
+-- ELEM
+
+elem9999999 :: C01
+elem9999999 = head $! generate 9999999 1 
+
+elem2500 :: C01
+elem2500 = head $! generate 2500 1 
+
+elems5000x5000 :: [C01]
+elems5000x5000 = generate 5000 5000
+
+elems10000x5000 :: [C01]
+elems10000x5000 = generate 10000 5000
+
+elems500 :: [C01]
+elems500 = generate 19500 500
+
+elems10000 :: [C01]
+elems10000 = generate 0 10000
+
+elems20000 :: [C01]
+elems20000 = generate 0 20000
+
+#ifndef BENCH_SMALL
+elems100000 :: [C01]
+elems100000 = generate 0 100000
+
+elems200000 :: [C01]
+elems200000 = generate 0 200000
+
+elems400000 :: [C01]
+elems400000 = generate 0 400000
+
+elems800000 :: [C01]
+elems800000 = generate 0 800000
+#endif
+
+generate :: Int -> Int -> [C01]
+generate o n = map (\x -> C01 x (x `div` s) [x .. x + s]) [o .. (n + o) - 1]
+  where
+    s = 5
+
+
diff --git a/benchmarks/src/Common.hs b/benchmarks/src/Common.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/src/Common.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-} 
+
+module Common
+( C01(..)
+) where
+
+--------------------------------------------------------------------------------
+import           Control.DeepSeq (NFData(..))
+import           Data.Data
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type as DS
+--------------------------------------------------------------------------------
+
+data C01 = C01 
+    {-# UNPACK #-} !Int
+    {-# UNPACK #-} !Int
+                   ![Int]
+    deriving (Eq, Ord, Show, Typeable)
+
+instance NFData C01 where
+    rnf (C01 x y z) = rnf x `seq` rnf y `seq` rnf z
+
diff --git a/benchmarks/src/DS/B01.hs b/benchmarks/src/DS/B01.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/src/DS/B01.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE TypeOperators #-}
+
+module DS.B01
+where
+
+--------------------------------------------------------------------------------
+import Control.Lens
+--------------------------------------------------------------------------------
+import Common (C01(..))
+--------------------------------------------------------------------------------
+import qualified Data.Store as S
+import           Data.Store (M, O, (.:), (.:.), (:.)(..), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||))
+import           Data.Store.Lens
+--------------------------------------------------------------------------------
+
+size :: DS -> Int
+size = S.size
+
+data DSTag = DSTag
+
+type DSTS  = Int :. Int :. Int
+type DSKRS = O   :. O   :. M
+type DSIRS = O   :. M   :. M
+
+type DS    = S.Store DSTag DSKRS DSIRS DSTS C01
+type DSKey = S.Key DSKRS DSTS
+type DSRawKey = S.RawKey DSKRS DSTS
+type DSSel = S.Selection DSTag DSKRS DSIRS DSTS
+
+key :: C01 -> DSKey
+key (C01 d1 d2 d3) = S.dimO d1 .: S.dimO d2 .:. S.dimM d3
+{-# INLINE key #-}
+
+sD1 :: (DSTag, S.N0)
+sD1 = (DSTag, S.n0)
+{-# INLINE sD1 #-}
+
+sD2 :: (DSTag, S.N1)
+sD2 = (DSTag, S.n1)
+{-# INLINE sD2 #-}
+
+sD3 :: (DSTag, S.N2)
+sD3 = (DSTag, S.n2)
+{-# INLINE sD3 #-}
+
+insert :: C01 -> DS -> DS
+insert e s = snd $! S.insert' (key e) e s
+
+insertUnsafe :: C01 -> DS -> DS
+insertUnsafe e s = snd $! S.unsafeInsert (key e) e s
+
+lookupOOEQ :: Int -> DS -> [(S.RawKey DSKRS DSTS, C01)]
+lookupOOEQ x = S.lookup (sD1 .== x)
+
+lookupOOEQLens :: Int -> DS -> DS
+lookupOOEQLens x o = o ^. with (sD1 .== x) 
+
+lookupOOGE :: Int -> DS -> [(S.RawKey DSKRS DSTS, C01)]
+lookupOOGE x = S.lookup (sD1 .>= x)
+
+lookupOOGELens :: Int -> DS -> DS
+lookupOOGELens x o = o ^. with (sD1 .>= x)
+
+lookupOMEQ :: Int -> DS -> [(S.RawKey DSKRS DSTS, C01)]
+lookupOMEQ x = S.lookup (sD2 .== x)
+
+lookupOMEQLens :: Int -> DS -> DS
+lookupOMEQLens x o = o ^. with (sD2 .== x)
+
+lookupOMGE :: Int -> DS -> [(S.RawKey DSKRS DSTS, C01)]
+lookupOMGE x = S.lookup (sD2 .>= x)
+
+lookupOMGELens :: Int -> DS -> DS
+lookupOMGELens x o = o ^. with (sD2 .>= x)
+
+lookupMMEQ :: Int -> DS -> [(S.RawKey DSKRS DSTS, C01)]
+lookupMMEQ x = S.lookup (sD3 .== x)
+
+lookupMMEQLens :: Int -> DS -> DS 
+lookupMMEQLens x o = o ^. with (sD3 .== x)
+
+empty :: DS
+empty = S.empty
+
+{-
+gen  n = map (\x -> C01 x (x `div` 5) [x .. x + 5]) [0 .. (n - 1)]
+gen' n = map (\x -> C01 (x `div` 2) (x `div` 5) [x .. x + 5]) [0 .. (n - 1)]
+store = foldl' (flip DS.B01.insert) empty $! gen 8
+newKey (C01 _ d2 d3) = key $ C01 0 d2 d3
+storeU = S.updateWithKey' (\_ e -> Just (e, Just $ newKey e)) (sD1 .>= 0) store
+-}
diff --git a/benchmarks/src/TS/B01.hs b/benchmarks/src/TS/B01.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/src/TS/B01.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-} 
+
+module TS.B01
+where
+
+--------------------------------------------------------------------------------
+import Control.Applicative
+import Control.DeepSeq (NFData(..))
+import Control.Lens
+--------------------------------------------------------------------------------
+import qualified Data.IntSet
+--------------------------------------------------------------------------------
+import Common (C01(..))
+--------------------------------------------------------------------------------
+import qualified Data.Table as T
+--------------------------------------------------------------------------------
+
+size :: T.Table t -> Int
+size = T.count
+
+instance T.Tabular C01 where
+  type PKT C01 = Int
+  data Key k C01 b where
+    D1 :: T.Key T.Primary         C01 Int
+    D2 :: T.Key T.SupplementalInt C01 Int
+    D3 :: T.Key T.InvertedInt     C01 Data.IntSet.IntSet
+  data Tab C01 i = C01IX
+    { ixd1 :: i T.Primary         Int
+    , ixd2 :: i T.SupplementalInt Int
+    , ixd3 :: i T.InvertedInt     Data.IntSet.IntSet
+    }
+
+  fetch D1 (C01 x _ _) = x
+  fetch D2 (C01 _ x _) = x
+  fetch D3 (C01 _ _ x) = Data.IntSet.fromList x
+
+  primary = D1
+  primarily D1 r = r
+
+  mkTab f =
+    C01IX <$> f D1
+          <*> f D2
+          <*> f D3
+  
+  forTab (C01IX d1 d2 d3) f =
+    C01IX <$> f D1 d1
+          <*> f D2 d2
+          <*> f D3 d3
+
+  ixTab (C01IX x _ _) D1 = x
+  ixTab (C01IX _ x _) D2 = x
+  ixTab (C01IX _ _ x) D3 = x
+
+instance NFData (T.Tab C01 (T.AnIndex C01)) where
+    rnf (C01IX x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3
+
+type TS = T.Table C01
+
+insert :: C01 -> TS -> TS
+insert = T.insert
+
+lookupOOEQ :: Int -> TS -> TS
+lookupOOEQ x o = o ^. T.with D1 (==) x 
+
+lookupOOGE :: Int -> TS -> TS
+lookupOOGE x o = o ^. T.with D1 (>=) x
+
+lookupOMEQ :: Int -> TS -> TS
+lookupOMEQ x o = o ^. T.with D2 (==) x
+
+lookupOMGE :: Int -> TS -> TS
+lookupOMGE x o = o ^. T.with D2 (>=) x
+
+lookupMMEQ :: Int -> TS -> TS
+lookupMMEQ x o = o ^. T.withAny D3 [x]
+
+empty :: TS
+empty = T.empty
+
diff --git a/data-store.cabal b/data-store.cabal
new file mode 100644
--- /dev/null
+++ b/data-store.cabal
@@ -0,0 +1,107 @@
+name:                data-store
+version:             0.3.0
+
+synopsis:    Type safe, in-memory dictionary with multidimensional keys.
+description: Type safe, in-memory dictionary with multidimensional keys.
+  Similar to ixset, higgsset, tables. But offers: type safe interface,
+  auto-increment dimensions, specifying the relationships between the key dimension and the elements (one-one, one-many, many-one, many-many), performance. 
+
+homepage: https://github.com/Palmik/data-store           
+
+license:             BSD3
+license-file:        LICENSE
+
+author:              Petr Pilař
+maintainer:          maintainer+the.palmik@gmail.com
+
+category:            Data
+
+build-type:          Simple
+cabal-version:       >= 1.8
+
+source-repository head
+  type: git
+  location: git://github.com/Palmik/data-store.git
+  branch: master
+
+library
+  hs-source-dirs:      src
+  exposed-modules:
+      Data.Store
+    , Data.Store.Selection
+    , Data.Store.Storable
+    , Data.Store.Lens
+    
+    , Data.Store.Internal.Type
+    , Data.Store.Internal.Function
+  
+  other-modules:
+      Data.Map.Extra
+    , Data.IntSet.Extra
+
+  build-depends:
+      base         >= 4.6 && < 5
+    , containers   >= 0.4 && < 1
+    , lens         >= 3.9 && < 4
+    , transformers >= 0.2 && < 0.3
+    , vector       >= 0.10 && < 0.2
+
+    , cereal     >= 0.3.5 && < 0.4
+    , deepseq    >= 1.3.0 && < 1.4
+    , safecopy   >= 0.8 && < 0.9
+  ghc-options: -O2 -Wall
+
+test-suite data-store-tests
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: tests, src
+  main-is:        Main.hs
+
+  other-modules:
+      Test.Data.Store01
+
+    , Data.Store    
+    , Data.Store.Lens    
+  
+  build-depends:
+      base       >= 4.5
+    , vector     >= 0.10
+    , containers >= 0.4
+    , lens       >= 3.9
+    , transformers >= 0.2
+    , tagged     >= 0.4
+
+    , test-framework             >= 0.8
+    , test-framework-quickcheck2 >= 0.3
+    , QuickCheck                 >= 2.4 && < 2.6
+
+benchmark data-store-benchmark-01
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: benchmarks/src, src
+  main-is:        01.hs
+
+  other-modules:
+      Common
+    , DS.B01
+    , TS.B01
+
+
+  build-depends:
+      base       >= 4.5
+    , vector     >= 0.9
+    , containers >= 0.4
+    , lens       >= 3.9
+    , transformers >= 0.2
+    , unordered-containers >= 0.2
+    , tagged     >= 0.4
+    , mtl        >= 2.1
+
+    , ixset
+    , tables     >= 0.3.1.1
+    , lens       >= 3.8
+    , bytestring 
+    , criterion  >= 0.6.2
+    , deepseq    >= 1.3.0
+    , random     >= 1.0.1
+  
+  ghc-options: -Wall -O2
+
diff --git a/src/Data/IntSet/Extra.hs b/src/Data/IntSet/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/IntSet/Extra.hs
@@ -0,0 +1,41 @@
+module Data.IntSet.Extra
+( foldrM
+, foldrM'
+, foldlM
+, foldlM'
+) where
+
+--------------------------------------------------------------------------------
+import qualified Data.IntSet
+--------------------------------------------------------------------------------
+
+-- TODO: Measure INLINE/SPECIALIZE tradeoff.
+
+-- | Monadic fold over the elements of a `Data.IntSet.IntSet`,
+-- associating to the right, i.e. from right to left. 
+foldrM :: Monad f => (Int -> b -> f b) -> b -> Data.IntSet.IntSet -> f b
+foldrM go start = Data.IntSet.foldr (\i acc -> acc >>= go i) (return start)
+{-# INLINE foldrM #-}
+--{-# SPECIALIZE foldrM :: (Int -> b -> Maybe b) -> b -> Data.IntSet.IntSet -> Maybe b #-}
+
+-- | Strict monadic fold over the elements of a `Data.IntSet.IntSet`,
+-- associating to the right, i.e. from right to left. 
+foldrM' :: Monad f => (Int -> b -> f b) -> b -> Data.IntSet.IntSet -> f b
+foldrM' go start = Data.IntSet.foldr' (\i acc -> acc >>= go i) (return start)
+{-# INLINE foldrM' #-}
+--{-# SPECIALIZE foldrM' :: (Int -> b -> Maybe b) -> b -> Data.IntSet.IntSet -> Maybe b #-}
+
+-- | Monadic fold over the elements of a `Data.IntSet.IntSet`,
+-- associating to the left, i.e. from left to right. 
+foldlM :: Monad f => (b -> Int -> f b) -> b -> Data.IntSet.IntSet -> f b
+foldlM go start = Data.IntSet.foldl (\acc i -> acc >>= flip go i) (return start)
+{-# INLINE foldlM #-}
+--{-# SPECIALIZE foldlM :: (b -> Int -> Maybe b) -> b -> Data.IntSet.IntSet -> Maybe b #-}
+
+-- | Monadic fold over the elements of a `Data.IntSet.IntSet`,
+-- associating to the left, i.e. from left to right. 
+foldlM' :: Monad f => (b -> Int -> f b) -> b -> Data.IntSet.IntSet -> f b
+foldlM' go start = Data.IntSet.foldl' (\acc i -> acc >>= flip go i) (return start)
+{-# INLINE foldlM' #-}
+--{-# SPECIALIZE foldlM' :: (b -> Int -> Maybe b) -> b -> Data.IntSet.IntSet -> Maybe b #-}
+
diff --git a/src/Data/Map/Extra.hs b/src/Data/Map/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Extra.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE CPP #-}
+
+module Data.Map.Extra
+( insertUnique
+) where
+
+--------------------------------------------------------------------------------
+import qualified Data.Map.Strict as Data.Map
+--------------------------------------------------------------------------------
+
+-- | The expression (@insertUnique k v old@)
+-- returns (@Just (Data.Map.insert k v old)@) if the map @old@ did not contain
+-- anything under the key @k@, otherwise returns @Nothing@.
+insertUnique :: Ord k => k -> a -> Data.Map.Map k a -> Maybe (Data.Map.Map k a)
+insertUnique k a m =
+    case Data.Map.insertLookupWithKey (\_ _ o' -> o') k a m of
+        (Nothing, res) -> Just res
+        (Just _,  _) -> Nothing
+{-# INLINE insertUnique #-}
+
diff --git a/src/Data/Store.hs b/src/Data/Store.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store.hs
@@ -0,0 +1,673 @@
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE CPP                 #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-} 
+
+--------------------------------------------------------------------------------
+-- |
+--
+-- Module : Data.Store
+-- Copyright : (c) Petr Pilar 2012
+-- License : BSD-style
+--
+-- Dictionary with multidimensional keys and type-safe interface.
+--
+-- These modules are intended to be imported qualified to avoid name
+-- clashes with prelude, e.g.:
+--
+-- > import qualified Data.Store as S
+-- > import           Data.Store (M, O, (.:), (.:.), (:.), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||))
+--
+-- Throughout out the documentation, the examples will be based on this
+-- code:
+--
+-- > {-# LANGUAGE TypeOperators #-}
+-- > 
+-- > module Example01
+-- > where
+-- > 
+-- > --------------------------------------------------------------------------------
+-- > import           Control.Applicative
+-- > import qualified Control.Monad.State as State
+-- > --------------------------------------------------------------------------------
+-- > import qualified Data.Store as S
+-- > import           Data.Store (M, O, (.:), (.:.), (:.)(..), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||))
+-- > --------------------------------------------------------------------------------
+-- > 
+-- > data Content = Content
+-- >     { contentName :: String  
+-- >     , contentBody :: String  
+-- >     , contentTags :: [String]
+-- >     , contentRating :: Double
+-- >     }
+-- > 
+-- > type ContentID = Int
+-- > 
+-- > -- Content has one ID, only one content can have a given ID.
+-- > -- Content has one name, only one content can have a given name.
+-- > -- Content has one body, many contents can have the same content.
+-- > -- Content has many tags, many contents can have the same tag.
+-- > -- Content has one rating, many contents can have the same rating.
+-- > 
+-- > data ContentStoreTag = ContentStoreTag
+-- > 
+-- > type ContentStoreTS  = ContentID :. String :. String :. String :. Double
+-- > type ContentStoreKRS = O         :. O      :. O      :. M      :. O
+-- > type ContentStoreIRS = O         :. O      :. M      :. M      :. M
+-- > type ContentStore = S.Store ContentStoreTag ContentStoreKRS ContentStoreIRS ContentStoreTS Content
+-- > type ContentStoreKey = S.Key ContentStoreKRS ContentStoreTS
+-- > type ContentStoreSelection = S.Selection ContentStoreTag ContentStoreKRS ContentStoreIRS ContentStoreTS
+-- > 
+-- > sContentID :: (ContentStoreTag, S.N0)
+-- > sContentID = (ContentStoreTag, S.n0)
+-- > 
+-- > sContentName :: (ContentStoreTag, S.N1)
+-- > sContentName = (ContentStoreTag, S.n1)
+-- > 
+-- > sContentBody :: (ContentStoreTag, S.N2)
+-- > sContentBody = (ContentStoreTag, S.n2)
+-- > 
+-- > sContentTag :: (ContentStoreTag, S.N3)
+-- > sContentTag = (ContentStoreTag, S.n3)
+-- > 
+-- > sContentRating :: (ContentStoreTag, S.N4)
+-- > sContentRating = (ContentStoreTag, S.n4)
+--
+-- Glossary
+--
+-- * Key (type/value) -- refers either to the type or value of a key of the
+-- store.
+--
+-- * Key dimension -- refers to one dimension of a key (e.g.: article's
+-- author, article's tag). Refers to the dimension as a whole, together
+-- with its properties, etc.
+--
+-- * Key dimension value -- refers to some concrete value from the domain of the
+-- dimension.
+--
+-- * Element (type/value) -- refers either to the type or value of the elements
+-- (in literature, the term \"value\" is usually used, be here it would
+-- clash far too often) of the store.
+--
+-- The implementation is based on "Data.Map", "Data.Set", "Data.IntMap" and
+-- "Data.IntSet".
+--
+-- The following variables and constants are used in Big-O notation:
+--
+-- * /W/ -- the (constant) number of bits of "Int" (32 or 64).
+-- 
+-- * /d/ -- the (constant) number of dimensions of the store.
+-- 
+-- * /k/ -- the (variable) number of key dimensions values of a key (or
+-- maximum of key dimension values over all keys in case of for example
+-- @'Data.Store.update'@).
+--
+-- * /s/ -- the (variable) size of the output of the operation or the
+-- (variable) number of elements affected by the operation. This is
+-- of then the number of key-element pairs that correspond to a selection.
+-- 
+-- * /s(sel)/ -- the (variable) number of key-element pairs that correspond
+-- to a selection /sel/ if /sel/ would otherwise be ambigious.
+--
+-- * /c/ -- the (variable) complexity of selection.
+--
+-- * /c/ -- the (variable) complexity of selection /sel/ if /sel/
+-- would otherwise be ambiguous.
+module Data.Store
+(
+  -- * Types
+  I.Store
+, I.Key
+, I.KeyDimension
+, I.RawKey
+, I.M
+, I.O
+, (I.:.)(..)
+, I.Auto
+
+  -- * Creating
+, I.empty
+, singleton
+
+  -- * Inserting
+, insert
+, insert'
+, unsafeInsert
+
+  -- * Updating
+, updateWithKey
+, updateWithKey'
+, update
+, update'
+, updateElements
+, delete
+
+  -- * Traversing
+, map
+
+  -- * Folding
+, foldr
+, foldrWithKey
+
+, foldl
+, foldlWithKey
+
+  -- * List
+, toList
+, elements
+, keys
+, fromList
+, fromList'
+, unsafeFromList
+
+  -- * Querying
+, size
+, lookup
+
+  -- ** Selection
+  --
+  -- $selection
+, Selection
+, not
+, (.<)
+, (.<=)
+, (.>)
+, (.>=)
+, (./=)
+, (.==)
+, (.&&)
+, (.||)
+
+  -- * Constructing Key
+  -- 
+  -- $constructing-key
+, dimA
+, dimO
+, dimM
+, (.:)
+, (.:.)
+
+  -- * Utility
+, I.S(..)
+, I.Z
+, I.N0
+, I.N1
+, I.N2
+, I.N3
+, I.N4
+, I.N5
+, I.N6
+, I.N7
+, I.N8
+, I.N9
+, I.N10
+, I.n0
+, I.n1
+, I.n2
+, I.n3
+, I.n4
+, I.n5
+, I.n6
+, I.n7
+, I.n8
+, I.n9
+, I.n10
+
+  -- * Debugging
+, showIndex
+, printIndex
+, moduleName
+) where
+
+--------------------------------------------------------------------------------
+import           Prelude hiding (lookup, map, foldr, foldl, not)
+--------------------------------------------------------------------------------
+import           Control.Applicative hiding (empty)
+--------------------------------------------------------------------------------
+import           Data.Monoid
+import           Data.Maybe
+import           Data.Functor.Identity
+import qualified Data.IntMap.Strict as Data.IntMap
+import qualified Data.List
+import qualified Data.Foldable
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type     as I
+import qualified Data.Store.Internal.Function as I
+import           Data.Store.Selection 
+--------------------------------------------------------------------------------
+
+-- | The name of this module.
+moduleName :: String
+moduleName = "Data.Store"
+{-# INLINE moduleName #-}
+
+-- INTERFACE
+
+-- $selection
+-- Functions from this category are used to create selections.
+--
+-- Example:
+--
+-- > -- Select any content with rating between 3 and 4.
+-- > let sel1 = sContentRating .> 3
+-- >
+-- > -- Select any content that is tagged with "haskell" or "category-theory"
+-- > -- and is not tagged with "fluff".
+-- > let sel2 = (sContentTag .== "haskell" .|| sContentTag .== "category-theory") .&& not' (sContentTag .== "fluff")
+-- >
+-- > -- Selection that is intersection of sel1 and sel2.
+-- > let sel3 = sel1 .&& sel2
+--
+-- These selections can be then used in functions like lookup, update,
+-- delete, etc.
+--  
+-- >>> lookup sel3 store
+-- > -- key-element pairs that match the selection
+--
+-- >>> delete (not' sel3) store
+-- > -- store with the key-element pairs that do not match the selection
+--
+-- >>> updateElements (\v -> Just v { contentRating = 5 }) sel3 store
+-- > -- store with the selected key-element pairs updated 
+
+
+-- $constructing-key
+-- Functions from this category are used to create a key for your store. Function for
+-- creating a key for our @Content@ data type could look like this:
+--
+-- > makeContentKey :: ContentID -> String -> String -> [String] -> Double -> ContentStoreKey
+-- > makeContentKey cid cn cb cts cr =
+-- >    S.dimO cid .: S.dimO cn .: S.dimO cb .: S.dimM cts .:. S.dimO cr
+--
+-- Notice that this function allows you to specify all the dimensions of
+-- the key, including the ID dimension. Usually we do not need this level
+-- of flexibility a would use function like this instead:
+--
+-- > contentKey :: Content -> ContentStoreKey
+-- > contentKey (Content cn cb cts cr) =
+-- >    S.dimA .: S.dimO cn .: S.dimO cb .: S.dimM cts .:. S.dimO cr
+--
+-- This function creates a key for given element of type @Content@ (element), the ID
+-- dimension is "automatic", which means that the assigned ID will be @succ
+-- max@ where @max@ is the value of the maximum ID in the store when
+-- inserting.
+--
+-- See also:
+--
+-- * 'Data.Store.Storable.Storable'
+
+-- | Function for creating an auto-increment dimension. Can be used instead
+-- of (@dimO x@) if the type is an instance of the
+-- @'Data.Store.Internal.Auto'@ type-class.
+dimA :: I.Auto t => I.KeyDimension I.O t
+dimA = I.KeyDimensionA
+{-# INLINE dimA #-}
+
+-- | Function for creating dimensions with the relation
+-- \"one-<anything>\".
+dimO :: Ord t => t -> I.KeyDimension I.O t
+dimO = I.KeyDimensionO
+{-# INLINE dimO #-}
+
+-- | Function for creating dimensions with the relation
+-- \"many-<anything>\".
+dimM :: Ord t => [t] -> I.KeyDimension I.M t
+dimM = I.KeyDimensionM
+{-# INLINE dimM #-}
+
+-- | Function for connecting one dimension and rest of the key.
+(.:) :: dim r t
+     -> I.GenericKey dim rs1 ts1 
+     -> I.GenericKey dim (r I.:. rs1) (t I.:. ts1)
+(.:) = I.KN
+{-# INLINE (.:) #-}
+infixr 3 .:
+
+-- | Function for connecting one dimensions with another (most often the
+-- last dimension of the key).
+(.:.) :: dim r1 t1
+      -> dim r2 t2
+      -> I.GenericKey dim (r1 I.:. r2) (t1 I.:. t2)
+(.:.) d1 d2 = I.KN d1 (I.K1 d2)
+{-# INLINE (.:.) #-}
+infixr 3 .:.
+
+-- CREATING
+
+
+-- | The expression (@'Data.Store.singleton' k v@) is store that contains
+-- only the @(k, v)@ as a key-element pair.
+singleton :: I.Empty (I.Index irs ts)
+          => I.Key krs ts -> v -> I.Store tag krs irs ts v
+singleton k v = snd . fromJust $ insert k v I.empty
+{-# INLINE singleton #-}
+
+-- INSERTING
+
+-- | The expression (@'Data.Store.insert' k e old@) is either
+-- @Nothing@ if inserting the @(k, e)@ key-element pair would cause
+-- a collision or (@Just (rk, new)@), where @rk@ is the raw key of
+-- @k@ and @new@ is store containing the same key-element pairs as @old@ plus
+-- @(k, e)@. 
+--
+-- Examples:
+--
+-- >>> let content = Content "name" "body" ["t1", "t2"] 0.5
+-- >>> insert (contentKey content) content store
+-- > Just (1 :. "name" :. "body" :. ["t1", "t2"] :. 0.5, <updated_store>)
+--
+-- See also:
+--
+-- * 'Data.Store.insert''
+-- * 'Data.Store.Internal.Type.Key'
+-- * 'Data.Store.Internal.Type.RawKey'
+insert :: I.Key krs ts
+       -> v
+       -> I.Store tag krs irs ts v
+       -> Maybe (I.RawKey krs ts, I.Store tag krs irs ts v)
+insert k v old@(I.Store _ index _) =
+    (\res -> (I.keyInternalToRaw internal, res)) <$> I.genericInsert I.indexInsertID internal v old
+    where
+      internal = I.keyToInternal index k
+
+-- | The expression (@'Data.Store.insert'' k v old@) is @(rk, new)@,
+-- where @rk@ is the raw key of @k@ and @new@ is a store that contains
+-- the same key-element pairs as @old@ plus @(k, e)@.
+-- Any key-value pairs from @old@ colliding with @(k, e)@ are not included in @new@.
+--
+-- See also:
+--
+-- * 'Data.Store.insert'
+-- * 'Data.Store.Internal.Type.Key'
+-- * 'Data.Store.Internal.Type.RawKey'
+insert' :: I.Key krs ts
+        -> e
+        -> I.Store tag krs irs ts e
+        -> (I.RawKey krs ts, I.Store tag krs irs ts e)
+insert' k e old@(I.Store _ index _) =
+    (I.keyInternalToRaw internal, runIdentity $! I.genericInsert I.indexInsertID' internal e old)
+    where
+      internal = I.keyToInternal index k
+{-# INLINE insert' #-}
+
+-- | UNSAFE! This function can corrupt the store.
+--
+-- The expression (@'Data.Store.unsafeInsert' k v old@) is @(rk, new)@,
+-- where @rk@ is the raw key of @k@ and @new@ is a store that contains
+-- the same key-element pairs as @old@ plus @(k, e)@.
+-- Any key-value pairs from @old@ colliding with @(k, e)@ will cause UNDEFINED BEHAVIOUR.
+--
+-- See also:
+--
+-- * 'Data.Store.insert'
+-- * 'Data.Store.insert''
+-- * 'Data.Store.Internal.Type.Key'
+-- * 'Data.Store.Internal.Type.RawKey'
+unsafeInsert :: I.Key krs ts
+             -> e
+             -> I.Store tag krs irs ts e
+             -> (I.RawKey krs ts, I.Store tag krs irs ts e)
+unsafeInsert k e old@(I.Store _ index _) =
+    (I.keyInternalToRaw internal, runIdentity $! I.genericInsert I.indexInsertID'' internal e old)
+    where
+      internal = I.keyToInternal index k
+{-# INLINE unsafeInsert #-}
+
+-- TRAVERSING
+
+-- | The expression @('Data.Store.map' tr old@) is store where every element of
+-- @old@ was transformed using the function @tr@.
+map :: (v1 -> v2) -> I.Store tag krs irs ts v1 -> I.Store tag krs irs ts v2
+map tr store@(I.Store vs _ _) = store
+    { I.storeV = Data.IntMap.map (\(ik, v) -> (ik, tr v)) vs
+    }
+{-# INLINE map #-}
+
+-- QUERYING
+
+-- | The expression (@'Data.Store.Selection.lookup' sel store@) is
+-- list of (raw key)-element pairs that match the selection.
+-- 
+-- Complexity: /O(c + s * min(n, W))/
+lookup :: IsSelection sel => sel tag krs irs ts -> I.Store tag krs irs ts v -> [(I.RawKey krs ts, v)]
+lookup sel s = I.genericLookup (resolve sel s) s
+{-# INLINE lookup #-}
+
+-- | The expression (@'Data.Store.size' store@) is the number of elements
+-- in @store@. 
+size :: I.Store tag krs irs ts v -> Int
+size (I.Store vs _ _) = Data.IntMap.size vs
+{-# INLINE size #-}
+
+-- UPDATING
+
+-- | The expression (@'Data.Store.updateWithKey' tr sel old@)
+-- is (@Just new@) where @new@ is a store containing the same key-element
+-- pairs as @old@ except for any key-element pairs @(k, e)@ that match the
+-- selection @sel@, those are updated as follows:
+--
+-- * If @(tr k e)@ is @Nothing@ the pair is not included in @new@.
+-- * If @(tr k e)@ is (@Just (e', Nothing)@) the pair is replaced by pair @(k, e')@.
+-- * If @(tr k e)@ is (@Just (e', Just k')@) the pair is replaced by pair @(k', e')@.
+--
+-- If any of the updated key-element pairs would cause a collision, the
+-- result is @Nothing@.
+--
+-- Complexity: /O(c + s * (min(n, W) + q * log n))/
+--
+-- See also:
+--
+--   * 'Data.Store.updateWithKey''
+updateWithKey :: IsSelection sel
+              => (I.RawKey krs ts -> v -> Maybe (v, Maybe (I.Key krs ts)))
+              -> sel tag krs irs ts
+              -> I.Store tag krs irs ts v
+              -> Maybe (I.Store tag krs irs ts v)
+updateWithKey tr sel s = I.genericUpdateWithKey I.indexInsertID tr (resolve sel s) s
+{-# INLINE updateWithKey #-}
+
+-- | The expression (@'Data.Store.updateWithKey'' tr sel old@)
+-- is @new@ where @new@ is a store containing the same key-element
+-- pairs as @old@ except for any key-element pairs @(k, e)@ that match the
+-- selection @sel@, those are updated as follows:
+--
+-- * If @(tr k e)@ is @Nothing@ the pair is not included in @new@.
+-- * If @(tr k e)@ is (@Just (e', Nothing)@) the pair is replaced by pair @(k, e')@.
+-- * If @(tr k e)@ is (@Just (e', Just k')@) the pair is replaced by pair @(k', e')@.
+--
+-- Any pairs of the original store @old@ that would, after the update, cause collisons
+-- are not included in @new@. 
+--
+-- Complexity: /O(c + d * s * (min(n, W) + q * log n))/
+--
+-- See also:
+--
+--   * 'Data.Store.updateWithKey'
+updateWithKey' :: IsSelection sel
+               => (I.RawKey krs ts -> v -> Maybe (v, Maybe (I.Key krs ts)))
+               -> sel tag krs irs ts
+               -> I.Store tag krs irs ts v
+               -> I.Store tag krs irs ts v
+updateWithKey' tr sel s = runIdentity $! I.genericUpdateWithKey I.indexInsertID' tr (resolve sel s) s
+{-# INLINE updateWithKey' #-}
+
+-- | The expression (@'Data.Store.update' tr sel s@) is equivalent
+-- to (@'Data.Store.Selection.updateWithKey' tr' sel s@) where
+-- (@tr' = (\_ v -> tr v) = const tr@).
+--
+-- Complexity: /O(c + s * (min(n, W) + q * log n))/ 
+update :: IsSelection sel
+       => (v -> Maybe (v, Maybe (I.Key krs ts)))
+       -> sel tag krs irs ts
+       -> I.Store tag krs irs ts v
+       -> Maybe (I.Store tag krs irs ts v)
+update tr = updateWithKey (const tr)
+{-# INLINE update #-}
+
+-- | The expression (@'Data.Store.update'' tr sel s@) is equivalent
+-- to (@'Data.Store.Selection.updateWithKey'' tr' sel s@) where
+-- (@tr' = (\_ v -> tr v) = const tr@).
+--
+-- Complexity: /O(c + d * s * (min(n, W) + q * log n))/ 
+update' :: IsSelection sel
+        => (v -> Maybe (v, Maybe (I.Key krs ts)))
+        -> sel tag krs irs ts
+        -> I.Store tag krs irs ts v
+        -> I.Store tag krs irs ts v
+update' tr = updateWithKey' (const tr)
+{-# INLINE update' #-}
+
+-- | The expression (@'Data.Store.updateElements' tr sel s@) is equivalent
+-- to (@'Data.Store.Selection.update' tr' sel s@) where
+-- (@tr' = (maybe Nothing (\v -> Just (v, Nothing)) . tr)@).
+--
+-- Complexity: /O(c + s * min(n, W))/ 
+updateElements :: IsSelection sel
+               => (v -> Maybe v)
+               -> sel tag krs irs ts
+               -> I.Store tag krs irs ts v
+               -> I.Store tag krs irs ts v
+updateElements tr sel s =
+  runIdentity $! I.genericUpdateWithKey I.indexInsertID'' tr' (resolve sel s) s
+  where
+    tr' _ = maybe Nothing (\v -> Just (v, Nothing)) . tr
+    {-# INLINE tr' #-}
+{-# INLINE updateElements #-}             
+
+-- | The expression (@'Data.Store.Selection.delete' sel old@) is
+-- equivalent to
+-- (@'Data.Store.fromJust' $ 'Data.Store.Selection.update' (const Nothing) sel old@).
+--
+-- Complexity: /O(c + s * (min(n, W) + q * log n)/ 
+delete :: IsSelection sel
+       => sel tag krs irs ts
+       -> I.Store tag krs irs ts v
+       -> I.Store tag krs irs ts v
+delete sel s =
+  runIdentity $! I.genericUpdateWithKey I.indexInsertID'' (\_ _ -> Nothing) (resolve sel s) s
+{-# INLINE delete #-}
+
+-- FOLDING
+
+-- | The expression (@'Data.Store.foldrWithKey' f z s@) folds the store
+-- using the given right-associative operator.
+foldrWithKey :: (I.RawKey krs ts -> v -> b -> b)
+             -> b
+             -> I.Store tag krs irs ts v
+             -> b
+foldrWithKey accum start (I.Store vs _ _) =
+    Data.IntMap.foldr (\(ik, v) b -> accum (I.keyInternalToRaw ik) v b) start vs
+{-# INLINE foldrWithKey #-}
+
+-- | The expression (@'Data.Store.foldr' f z s@) folds the store
+-- using the given right-associative binary operator.
+foldr :: (v -> b -> b)
+      -> b
+      -> I.Store tag krs irs ts v
+      -> b
+foldr accum start (I.Store vs _ _) =
+    Data.IntMap.foldr (\(_, v) b -> accum v b) start vs
+{-# INLINE foldr #-}
+
+-- | The expression (@'Data.Store.foldlWithKey' f z s@) folds the store
+-- using the given left-associative operator.
+foldlWithKey :: (b -> I.RawKey krs ts -> v -> b)
+              -> b 
+              -> I.Store tag krs irs ts v
+              -> b
+foldlWithKey accum start (I.Store vs _ _) =
+    Data.IntMap.foldl (\b (ik, v) -> accum b (I.keyInternalToRaw ik) v) start vs
+{-# INLINE foldlWithKey #-}
+
+-- | The expression (@'Data.Store.foldl' f z s@) folds the store
+-- using the given left-associative binary operator.
+foldl :: (b -> v -> b)
+      -> b
+      -> I.Store tag krs irs ts v
+      -> b
+foldl accum start (I.Store vs _ _) =
+    Data.IntMap.foldl (\b (_, v) -> accum b v) start vs
+{-# INLINE foldl #-}
+
+-- LISTS
+
+-- | The expression (@'Data.Store.toList' store@) is a list of key-element pairs that are stored in @store@.
+toList :: I.Store tag krs irs ts v -> [(I.RawKey krs ts, v)]
+toList (I.Store vs _ _) = Data.List.map (\(ik, v) -> (I.keyInternalToRaw ik, v)) $ Data.IntMap.elems vs
+{-# INLINE toList #-}
+
+-- | The expression (@'Data.Store.elements' store@) is a list of elements that
+-- are stored in @store@.
+elements :: I.Store tag krs irs ts v -> [v]
+elements (I.Store vs _ _) = Data.List.map snd $ Data.IntMap.elems vs
+{-# INLINE elements #-}
+
+-- | The expression (@'Data.Store.keys' store@) is a list of pairs raw
+-- keys that are stored in @store@.
+keys :: I.Store tag krs irs ts v -> [I.RawKey krs ts]
+keys (I.Store vs _ _) = Data.List.map (I.keyInternalToRaw . fst) $ Data.IntMap.elems vs
+{-# INLINE keys #-}
+
+-- | The expression (@'Data.Store.fromList' kvs@) is either
+-- a) (@Just store@) where @store@ is a store containing exactly the given
+-- key-element pairs or;
+-- b) @Nothing@ if inserting any of the key-element pairs would
+-- cause a collision.
+--
+-- See also:
+--
+-- * 'Data.Store.fromList''
+fromList :: I.Empty (I.Index irs ts) => [(I.Key krs ts, v)] -> Maybe (I.Store tag krs irs ts v)
+fromList = Data.Foldable.foldlM (\s (k, v) -> snd <$> insert k v s) I.empty 
+{-# INLINE fromList #-}
+
+-- | The expression (@'Data.Store.fromList'' kvs@) is @store@
+-- containing the given key-element pairs (colliding pairs are not included).
+--
+-- See also:
+--
+-- * 'Data.Store.fromList'
+fromList' :: I.Empty (I.Index irs ts) => [(I.Key krs ts, v)] -> I.Store tag krs irs ts v
+fromList' = Data.List.foldl' (\s (k, v) -> snd $! insert' k v $! s) I.empty 
+{-# INLINE fromList' #-}
+
+-- | UNSAFE! This function can corrupt the store.
+-- 
+-- The expression (@'Data.Store.fromList'' kvs@) is @store@
+-- containing the given key-element pairs (colliding pairs cause UNDEFINED BEHAVIOUR).
+--
+-- See also:
+--
+-- * 'Data.Store.fromList'
+-- * 'Data.Store.fromList'
+unsafeFromList :: I.Empty (I.Index irs ts) => [(I.Key krs ts, v)] -> I.Store tag krs irs ts v
+unsafeFromList = Data.Foldable.foldl (\s (k, v) -> snd $ unsafeInsert k v s) I.empty 
+{-# INLINE unsafeFromList #-}
+
+-- INSTANCES
+
+instance Functor (I.Store tag krs irs ts) where
+    fmap = map
+    {-# INLINE fmap #-}
+
+instance I.Empty (I.Index irs ts) => Monoid (I.Store tag krs irs ts v) where
+    mempty = I.empty
+    {-# INLINE mempty #-}
+
+    mappend oldl (I.Store kes _ _) =
+      Data.IntMap.foldl (\acc (ik, e) -> runIdentity $! I.genericInsert I.indexInsertID' ik e acc) oldl kes
+
+-- UTILITY
+
+showIndex :: Show (I.Index irs ts) => I.Store tag krs irs ts v -> String
+showIndex (I.Store _ i _) = show i
+{-# INLINE showIndex #-}
+
+printIndex :: Show (I.Index irs ts) => I.Store tag krs irs ts v -> IO ()
+printIndex = putStrLn . showIndex
+{-# INLINE printIndex #-}
+
+-- INTERNAL
diff --git a/src/Data/Store/Internal/Function.hs b/src/Data/Store/Internal/Function.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Internal/Function.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
+
+module Data.Store.Internal.Function
+where
+
+--------------------------------------------------------------------------------
+import           Control.Applicative hiding (empty)
+--------------------------------------------------------------------------------
+import           Data.Monoid ((<>))
+import           Data.Functor.Identity 
+import qualified Data.List
+import qualified Data.IntMap.Strict as Data.IntMap
+import qualified Data.Map
+import qualified Data.IntSet
+import qualified Data.IntSet.Extra
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type as I
+--------------------------------------------------------------------------------
+
+moduleName :: String
+moduleName = "Data.Store.Internal.Function"
+
+genericSubset :: I.Empty (I.Index irs ts)
+              => Data.IntSet.IntSet
+              -> I.Store tag krs irs ts v
+              -> I.Store tag krs irs ts v
+genericSubset ids (I.Store vs _ _) =
+  Data.IntSet.foldr (\i acc ->
+    case Data.IntMap.lookup i vs of
+      Just (ik, e) -> runIdentity $! genericInsert indexInsertID'' ik e acc
+      _ -> acc
+    ) I.empty ids
+{-# INLINE genericSubset #-}
+
+genericLookup :: Data.IntSet.IntSet
+              -> I.Store tag krs irs ts v
+              -> [(I.RawKey krs ts, v)]
+genericLookup ids (I.Store vs _ _) = {-# SCC "genericLookup" #-} 
+  Data.IntSet.foldr (\i acc ->
+    case Data.IntMap.lookup i vs of
+      Just (ik, v) -> (keyInternalToRaw ik, v) : acc
+      _ -> acc
+    ) [] ids
+{-# INLINE genericLookup #-}
+
+genericUpdateWithKey :: (Applicative f, Monad f)
+                     => (I.IKey krs ts -> Int -> I.Store tag krs irs ts e -> f (I.Store tag krs irs ts e))
+                     -> (I.RawKey krs ts -> e -> Maybe (e, Maybe (I.Key krs ts)))
+                     -> Data.IntSet.IntSet
+                     -> I.Store tag krs irs ts e
+                     -> f (I.Store tag krs irs ts e)
+genericUpdateWithKey ins tr ids old = Data.IntSet.Extra.foldlM' accum old ids
+    where
+      accum store@(I.Store vs ix nid) i =
+          case Data.IntMap.lookup i vs of
+            Just (ik, v) ->
+                case tr (keyInternalToRaw ik) v of
+                  -- User wants to update the element & key.
+                  Just (nv, Just nk) -> let nik = mergeKeys nk ik in 
+                    if nik /= ik
+                       -- The keys are different: update the element & key.
+                       then insertPair i nik nv <$> ins nik i (store { I.storeI = indexDeleteID ik i ix })
+                       -- The keys are identical: update the element.
+                       else pure $! insertPair i nik nv store
+
+                  -- Update the element.
+                  Just (nv, Nothing) -> pure $! insertPair i ik nv store
+
+                  -- Delete.
+                  Nothing -> pure I.Store
+                    { I.storeV = Data.IntMap.delete i vs
+                    , I.storeI = indexDeleteID ik i ix
+                    , I.storeNID = nid
+                    }
+            _ -> pure store
+      {-# INLINEABLE accum #-}
+      
+      insertPair i' ik' e' s'@(I.Store es' _ _) = s' 
+        { I.storeV = Data.IntMap.insert i' (ik', e') es'
+        }
+      {-# INLINE insertPair #-}
+{-# INLINE genericUpdateWithKey #-}
+
+
+mergeKeys :: I.Key krs ts -> I.IKey krs ts -> I.IKey krs ts
+mergeKeys (I.K1 I.KeyDimensionA) ik@(I.K1 _) = ik
+mergeKeys (I.K1 (I.KeyDimensionO d))   (I.K1 _)   = I.K1 (I.IKeyDimensionO d)
+mergeKeys (I.K1 (I.KeyDimensionM d))   (I.K1 _)   = I.K1 (I.IKeyDimensionM d)
+mergeKeys (I.KN I.KeyDimensionA s) (I.KN ik is) = I.KN ik $ mergeKeys s is
+mergeKeys (I.KN (I.KeyDimensionO d) s) (I.KN _ is) = I.KN (I.IKeyDimensionO d) $ mergeKeys s is
+mergeKeys (I.KN (I.KeyDimensionM d) s) (I.KN _ is) = I.KN (I.IKeyDimensionM d) $ mergeKeys s is
+mergeKeys _ _ = error $ moduleName <> ".genericUpdate.mergeKeys: The impossible happened."
+{-# INLINEABLE mergeKeys #-}
+
+keyInternalToRaw :: I.IKey krs ts -> I.RawKey krs ts
+keyInternalToRaw (I.K1 (I.IKeyDimensionO x)) = x
+keyInternalToRaw (I.K1 (I.IKeyDimensionM x)) = x
+keyInternalToRaw (I.KN (I.IKeyDimensionO x) s) = x I.:. keyInternalToRaw s
+keyInternalToRaw (I.KN (I.IKeyDimensionM x) s) = x I.:. keyInternalToRaw s
+{-# INLINE keyInternalToRaw #-}
+
+keyFromInternal :: I.IKey krs ts -> I.Key krs ts
+keyFromInternal (I.K1 (I.IKeyDimensionO x)) = I.K1 (I.KeyDimensionO x)
+keyFromInternal (I.K1 (I.IKeyDimensionM x)) = I.K1 (I.KeyDimensionM x)
+keyFromInternal (I.KN (I.IKeyDimensionO x) s) = I.KN (I.KeyDimensionO x) (keyFromInternal s)
+keyFromInternal (I.KN (I.IKeyDimensionM x) s) = I.KN (I.KeyDimensionM x) (keyFromInternal s)
+
+keyToInternal :: I.Index irs ts -> I.Key krs ts -> I.IKey krs ts
+keyToInternal (I.I1 ix) (I.K1 I.KeyDimensionA) = I.K1 (I.IKeyDimensionO $! nextKey ix) 
+keyToInternal (I.I1 _) (I.K1 (I.KeyDimensionO x)) = I.K1 (I.IKeyDimensionO x) 
+keyToInternal (I.I1 _) (I.K1 (I.KeyDimensionM x)) = I.K1 (I.IKeyDimensionM x) 
+keyToInternal (I.IN ix is) (I.KN I.KeyDimensionA s) = I.KN (I.IKeyDimensionO $! nextKey ix) $ keyToInternal is s
+keyToInternal (I.IN _ is) (I.KN (I.KeyDimensionO x) s) = I.KN (I.IKeyDimensionO x) $ keyToInternal is s
+keyToInternal (I.IN _ is) (I.KN (I.KeyDimensionM x) s) = I.KN (I.IKeyDimensionM x) $ keyToInternal is s 
+keyToInternal _ _ = error $ moduleName <> ".insert.keyToInternal: Impossible happened."
+{-# INLINE keyToInternal #-}
+      
+nextKey :: I.Auto t => I.IndexDimension r t -> t
+nextKey i =
+  case i of
+    (I.IndexDimensionM m) -> nextKey' m
+    (I.IndexDimensionO m) -> nextKey' m
+  where
+    nextKey' m = if Data.Map.null m
+                   then minBound
+                   else succ . fst $! Data.Map.findMax m
+    {-# INLINE nextKey' #-}
+{-# INLINE nextKey #-}
+
+genericInsert :: Applicative f 
+              => (I.IKey krs ts -> Int -> I.Store tag krs irs ts e -> f (I.Store tag krs irs ts e))
+              -> I.IKey krs ts
+              -> e
+              -> I.Store tag krs irs ts e
+              -> f (I.Store tag krs irs ts e)
+genericInsert ins ik e old@(I.Store _ _ nid) = go <$> ins ik nid old
+  where
+    go s'@(I.Store es' _ _) = s'
+      { I.storeV = Data.IntMap.insert nid (ik, e) es'
+      , I.storeNID = nid + 1
+      }
+    {-# INLINE go #-}
+{-# INLINE genericInsert #-}
+
+-- | Inserts the given element identifier into the store's index under the given
+-- internal key.
+--
+-- In case of collisions: returns 'Data.Maybe.Nothing'.
+indexInsertID :: I.IKey krs ts
+              -> Int
+              -> I.Store tag krs irs ts e
+              -> Maybe (I.Store tag krs irs ts e)
+indexInsertID ik eid old@(I.Store _ index _) =
+  if Data.List.null $ findCollisions ik index
+    then Just $! runIdentity $! indexInsertID'' ik eid old
+    else Nothing
+{-# INLINE indexInsertID #-}
+
+-- | Inserts the given element identifier into the store's index under the given
+-- internal key.
+--
+-- In case of collisions: deletes them.
+indexInsertID' :: I.IKey krs ts
+               -> Int
+               -> I.Store tag krs irs ts e
+               -> Identity (I.Store tag krs irs ts e)
+indexInsertID' ik eid old@(I.Store _ index _) = --{-# SCC "indexInsertID'" #-} 
+  indexInsertID'' ik eid $! Data.IntSet.foldl' go old collisions
+  where
+    go s'@(I.Store es' ix' _) i =
+      case Data.IntMap.updateLookupWithKey (\_ _ -> Nothing) i es' of
+        (Just (ik', _), v'') -> s'
+          { I.storeV = v''
+          , I.storeI = indexDeleteID ik' i ix'
+          } 
+        _ -> error $ moduleName <> ".insertInternal'.go: The impossible happened."
+    {-# INLINEABLE go #-}
+
+    collisions = Data.IntSet.delete eid $! Data.IntSet.fromList $! findCollisions ik index
+    {-# INLINE collisions #-}
+{-# INLINE indexInsertID' #-}
+
+-- | UNSAFE. Inserts the given element identifier into the store's index under the given
+-- internal key.
+-- 
+-- In case of collisions: ignores them.
+indexInsertID'' :: I.IKey krs ts
+                -> Int
+                -> I.Store tag krs irs ts e
+                -> Identity (I.Store tag krs irs ts e)
+indexInsertID'' ik eid old@(I.Store _ index _) = --{-# SCC "indexInsertID''" #-}
+  zipped `seq` Identity $! old { I.storeI = zipped }
+  where
+    zipped = zipD ik index
+
+    zipD :: I.IKey krs ts -> I.Index irs ts -> I.Index irs ts
+    zipD (I.KN kd kt) (I.IN ixd it) = I.IN (combine kd ixd) $! zipD kt it
+    zipD (I.K1 kd) (I.I1 ixd) = I.I1 $! combine kd ixd
+    zipD _ _ = error $ moduleName <> ".indexInsertID''.zipD: The impossible happened."
+    {-# INLINE zipD #-}
+
+    combine :: I.IKeyDimension krs ts -> I.IndexDimension irs ts -> I.IndexDimension irs ts
+    combine kd ixd =
+      case (ixd, kd) of
+        (I.IndexDimensionO m, I.IKeyDimensionO k)  ->
+          I.IndexDimensionO $! goO k eid m
+        
+        (I.IndexDimensionO m, I.IKeyDimensionM ks) ->
+          I.IndexDimensionO $! Data.List.foldl' (\acc k -> goO k eid acc) m ks 
+
+        (I.IndexDimensionM m, I.IKeyDimensionO k)  ->
+          I.IndexDimensionM $! goM k eid $! m
+
+        (I.IndexDimensionM m, I.IKeyDimensionM ks) ->
+          I.IndexDimensionM $! Data.List.foldl' (\acc k -> goM k eid acc) m ks
+    {-# INLINEABLE combine #-}
+
+    goO :: Ord k => k -> Int -> Data.Map.Map k Int -> Data.Map.Map k Int
+    goO = Data.Map.insert 
+    {-# INLINE goO #-}
+
+    goM :: Ord k => k -> Int -> Data.Map.Map k Data.IntSet.IntSet -> Data.Map.Map k Data.IntSet.IntSet
+    goM k e = Data.Map.insertWith (\_ s -> Data.IntSet.insert e s) k (Data.IntSet.singleton e)
+    {-# INLINE goM #-}
+{-# INLINE indexInsertID'' #-}
+
+findCollisions :: I.IKey krs ts -> I.Index irs ts -> [Int]
+findCollisions ik ix = {-# SCC "findCollisions" #-} zipD ik ix [] 
+  where
+    zipD :: I.IKey krs ts -> I.Index irs ts -> [Int] -> [Int]
+    zipD (I.KN kd kt) (I.IN ixd it) = combine kd ixd . zipD kt it
+    zipD (I.K1 kd) (I.I1 ixd) = combine kd ixd
+    zipD _ _ = error $ moduleName <> ".findCollisions.zipD: The impossible happened."
+
+    combine :: I.IKeyDimension krs ts -> I.IndexDimension irs ts -> [Int] -> [Int]
+    combine kd ixd = 
+      case (ixd, kd) of
+        (I.IndexDimensionO m, I.IKeyDimensionO k)  -> goO k m
+        (I.IndexDimensionO m, I.IKeyDimensionM ks) -> foldr (\k acc -> goO k m . acc) id ks
+        _ -> id
+    {-# INLINE combine #-}
+
+    goO :: Ord k => k -> Data.Map.Map k Int -> [Int] -> [Int]
+    goO k m =
+      case Data.Map.lookup k $! m of
+        Nothing -> id
+        Just  i -> (i:)
+    {-# INLINE goO #-}
+
+-- | Deletes EID fron an index.
+indexDeleteID :: I.IKey krs ts
+              -> Int
+              -> I.Index irs ts
+              -> I.Index irs ts
+indexDeleteID ik eid = zipD ik
+  where
+    zipD :: I.IKey krs ts -> I.Index irs ts -> I.Index irs ts
+    zipD (I.KN kd kt) (I.IN ixd it) = I.IN (combine kd ixd) $! zipD kt it
+    zipD (I.K1 kd) (I.I1 ixd) = I.I1 $! combine kd ixd
+    zipD _ _ = error $ moduleName <> ".indexDeleteID.zipD: The impossible happened."
+    {-# INLINEABLE zipD #-}
+
+    combine :: Ord t => I.IKeyDimension kr t -> I.IndexDimension ir t -> I.IndexDimension ir t
+    combine key index =
+      case (index, key) of
+        (I.IndexDimensionO m, I.IKeyDimensionO k)  -> I.IndexDimensionO $! goO m k
+        (I.IndexDimensionO m, I.IKeyDimensionM ks) -> I.IndexDimensionO $! Data.List.foldl' goO m ks
+        (I.IndexDimensionM m, I.IKeyDimensionO k)  -> I.IndexDimensionM $! goM m k
+        (I.IndexDimensionM m, I.IKeyDimensionM ks) -> I.IndexDimensionM $! Data.List.foldl' goM m ks
+    {-# INLINEABLE combine #-}
+
+    goO :: Ord k => Data.Map.Map k Int -> k -> Data.Map.Map k Int
+    goO m k = Data.Map.update (\i' -> if i' == eid then Nothing else Just i') k m
+    {-# INLINE goO #-}
+
+    goM :: Ord k => Data.Map.Map k Data.IntSet.IntSet -> k -> Data.Map.Map k Data.IntSet.IntSet
+    goM m k = Data.Map.update
+      (\ids -> let nids = Data.IntSet.delete eid ids in
+        if Data.IntSet.null nids
+          then Nothing
+          else Just nids
+      ) k m
+    {-# INLINE goM #-}
+{-# INLINE indexDeleteID #-}
+
diff --git a/src/Data/Store/Internal/Type.hs b/src/Data/Store/Internal/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Internal/Type.hs
@@ -0,0 +1,555 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+
+module Data.Store.Internal.Type
+where
+
+--------------------------------------------------------------------------------
+import           Control.Applicative ((<$>), (<*>))
+import           Control.DeepSeq (NFData(rnf))
+--------------------------------------------------------------------------------
+import           Data.Data (Typeable, Typeable2)
+import qualified Data.Data
+import qualified Data.List
+import qualified Data.Map.Strict    as Data.Map
+import           Data.Monoid ((<>))
+import qualified Data.IntMap.Strict as Data.IntMap
+import qualified Data.IntSet
+import qualified Data.Foldable as F
+
+import qualified Data.SafeCopy  as Ser
+import qualified Data.Serialize as Ser (Serialize, get, put)
+--------------------------------------------------------------------------------
+
+moduleName :: String
+moduleName = "Data.Store.Internal.Type"
+
+-- | This is type-level tag for tagging dimensions of key and the index of a store.
+-- You can think of @'Data.Store.Internal.Type.M'@ as an abbreviation for
+-- "many".
+--
+-- * When @'Data.Store.Internal.Type.Key'@ dimension is tagged with
+-- @'Data.Store.Internal.Type.M'@, it means that a single element can be
+-- indexed under multiple key dimension values. Example: @Content@ (element) has
+-- many tags.
+--
+-- * When @'Data.Store.Internal.Type.Index'@ dimension is tagged with
+-- @'Data.Store.Internal.Type.M'@, it means that a multiple elements can be
+-- indexed under a single key dimension values. Example: One rating can be shared by
+-- many @Content@s (elements).
+--
+-- See also:
+--
+-- * 'Data.Store.Internal.Type.O'
+--
+-- * 'Data.Store.Internal.Type.Key'
+--
+-- * 'Data.Store.Internal.Type.Store'
+data M 
+
+-- | This is type-level tag for tagging dimensions of key and the index of a store.
+-- You can think of @'Data.Store.Internal.Type.O'@ as an abbreviation for
+-- "one".
+--
+-- * When @'Data.Store.Internal.Type.Key'@ dimension is tagged with
+-- @'Data.Store.Internal.Type.O'@, it means that a single element is indexed
+-- under exactly one key dimension value. Example: @Content@ (element) has exactly one title.
+--
+-- * When @'Data.Store.Internal.Type.Index'@ dimension is tagged with
+-- @'Data.Store.Internal.Type.O'@, it means that at most one element can be
+-- indexed under one key dimension value. Example: One @ContentID@ corresponds
+-- to at most one @Content@ (element).
+--
+-- See also:
+--
+-- * 'Data.Store.Internal.Type.M'
+--
+-- * 'Data.Store.Internal.Type.Key'
+--
+-- * 'Data.Store.Internal.Type.Store'
+data O
+
+-- | Type-level zero.
+data Z = Z
+
+-- | Type-level successor of a number.
+data S n = S n
+
+type N0 = Z
+type N1 = S N0
+type N2 = S N1
+type N3 = S N2
+type N4 = S N3
+type N5 = S N4
+type N6 = S N5
+type N7 = S N6
+type N8 = S N7
+type N9 = S N8
+type N10 = S N9
+
+n0 :: N0
+n0 = Z
+n1 :: N1
+n1 = S n0
+n2 :: N2
+n2 = S n1
+n3 :: N3
+n3 = S n2
+n4 :: N4
+n4 = S n3
+n5 :: N5
+n5 = S n4
+n6 :: N6
+n6 = S n5
+n7 :: N7
+n7 = S n6
+n8 :: N8
+n8 = S n7
+n9 :: N9
+n9 = S n8
+n10 :: N10
+n10 = S n9
+
+type family   DimensionRelation n rs ts :: *
+type instance DimensionRelation Z O ts = O
+type instance DimensionRelation Z M ts = M
+type instance DimensionRelation Z (r :. rt) (t :. tt) = r
+type instance DimensionRelation (S n) (r :. rt) (t :. tt) = DimensionRelation n rt tt
+
+type family   DimensionType n rs ts :: *
+type instance DimensionType Z M t = t
+type instance DimensionType Z O t = t
+type instance DimensionType Z (r :. rt) (t :. tt) = t
+type instance DimensionType (S n) (r :. rt) (t :. tt) = DimensionType n rt tt
+
+type family   RawDimensionType n a :: *
+type instance RawDimensionType n (Index irs ts) = IndexDimension (DimensionRelation n irs ts) (DimensionType n irs ts)
+
+-- | The pupose of the @'Data.Store.Internal.Type.RawKey'@ type family is
+-- to derive a type of a \"raw key\" that is easier to pattern match against
+-- than @'Data.Store.Internal.Key'@.
+--
+-- Example:
+--
+-- > RawKey (O :. O :. O :. M :. O) (ContentID :. String :. String :. String :. Double) ~ (ContentID :. String :. String :. [String] :. Double)
+type family   RawKey kspec tspec :: *
+type instance RawKey (O :. rt) (t :. tt) =  t  :. RawKey rt tt
+type instance RawKey (M :. rt) (t :. tt) = [t] :. RawKey rt tt
+type instance RawKey O t =  t
+type instance RawKey M t = [t]
+
+class (Ord k, Enum k, Bounded k) => Auto k where
+instance (Ord k, Enum k, Bounded k) => Auto k where
+
+-- | The store data type has four type arguments that define what and how
+-- things are stored.
+--
+-- The @krs@ (key relation specification) and @irs@ (index relation
+-- specification) define the relations between the dimensions of the key
+-- and the elements. To that end, we use @'Data.Store.Internal.Type.O'@ and
+-- @'Data.Store.Internal.Type.M'@ type-level tags and
+-- @'Data.Store.Type.Internal.(:.)'@ data type to create tuple of these
+-- tags (to describe all the dimensions).
+--
+-- The possible relations are as follows:
+--
+-- * One-one: Every intem is indexed under exactly one key dimension value. One key dimension value
+-- corresponds to at most one elements.
+--
+-- * One-many: Every element is indexed under exactly one key dimension value. One key dimension value can
+-- correspond to many elements.
+--
+-- * Many-one: Every element can be indexed under multiple (zero or more) key dimension values. One key dimension value
+-- corresponds to at most one elements.
+--
+-- * Many-many: Every element cab be indexed under multiple (zero or more) key dimension value. One key dimension value
+-- can correspond to many elements.
+--
+-- The @ts@ (type specification) defines the type of the key's dimensions
+-- and finally @v@ is the type of the elements stored.
+--
+-- In our example with @Content@, we have five dimensions: ID, name, body,
+-- tags and rating. We would like our store to have these properties:
+--
+-- * @Content@ has one ID, only one content can have a given ID.
+--
+-- * @Content@ has one name, only one content can have a given name.
+--
+-- * @Content@ has one body, many contents can have the same content.
+--
+-- * @Content@ has many tags, many contents can have tte same tag.
+--
+-- * @Content@ has one rating, many contents can have the same rating.
+--
+-- So in our case, we define:
+--
+-- > type ContentStoreKRS = O         :. O      :. O      :. M      :. O
+-- > type ContentStoreIRS = O         :. O      :. M      :. M      :. M
+-- > type ContentStoreTS  = ContentID :. String :. String :. String :. Double
+-- > type ContentStore = Store ContentStoreKRS ContentStoreIRS ContentStoreTS Content
+--
+-- See also:
+--
+-- * 'Data.Store.Internal.Type.O'
+--
+-- * 'Data.Store.Internal.Type.M'
+--
+-- * 'Data.Store.Internal.Type.(:.)'
+--
+-- * 'Data.Store.Internal.Type.Key'
+--
+data Store tag krs irs ts v = Store
+    { storeV :: !(Data.IntMap.IntMap (IKey krs ts, v))
+    , storeI :: !(Index irs ts)
+    , storeNID :: {-# UNPACK #-} !Int
+    } deriving (Typeable)
+
+instance (Show h, Show t) => Show (h :. t) where
+    show (h :. t) = show h <> " :. " <> show t
+
+instance (Ser.Serialize (IKey krs ts), Ser.Serialize (Index irs ts), Ser.Serialize v) => Ser.Serialize (Store tag krs irs ts v) where
+    get = Store <$> Ser.get <*> Ser.get <*> Ser.get
+    put (Store vs ix nid) = Ser.put vs >> Ser.put ix >> Ser.put nid
+
+instance (Ser.SafeCopy (IKey krs ts), Ser.SafeCopy (Index irs ts), Ser.SafeCopy v) => Ser.SafeCopy (Store tag krs irs ts v) where
+    getCopy = Ser.contain $ Store <$> Ser.safeGet <*> Ser.safeGet <*> Ser.safeGet
+    putCopy (Store vs ix nid) = Ser.contain $ Ser.safePut vs >> Ser.safePut ix >> Ser.safePut nid
+
+instance (Show (IKey krs ts), Show v) => Show (Store tag krs irs ts v) where
+    show (Store vs _ _) = "[" <> go <> "]"
+      where
+        go = Data.List.intercalate "," $ map (\(ik, v) -> "((" <> show ik <> "), " <> show v <> ")")
+                                       $ F.toList vs
+
+data GenericKey dim rs ts where
+    KN :: !(dim r t) -> !(GenericKey dim rt tt) -> GenericKey dim (r :. rt) (t :. tt)
+    K1 :: !(dim r t) -> GenericKey dim r t
+
+instance Eq (GenericKey IKeyDimension rs ts) where
+    (K1 x) == (K1 y) = x == y
+    (KN x xt) == (KN y yt) = x == y && xt == yt
+    _ == _ = False    
+
+    (K1 x) /= (K1 y) = x /= y
+    (KN x xt) /= (KN y yt) = x /= y || xt /= yt
+    _ /= _ = True
+
+{-
+instance Eq (dim O t) => Eq (GenericKey dim O t) where
+    (K1 x) == (K1 y) = x == y
+    (K1 x) /= (K1 y) = x /= y
+
+instance Eq (dim M t) => Eq (GenericKey dim M t) where
+    (K1 x) == (K1 y) = x == y
+    (K1 x) /= (K1 y) = x /= y
+
+instance (Eq (dim r t), Eq (GenericKey dim rt tt)) => Eq (GenericKey dim (r :. rt) (t :. tt)) where
+    (KN x xt) == (KN y yt) = x == y && xt == yt
+    _ == _ = False
+
+    (KN x xt) /= (KN y yt) = x /= y || xt /= yt
+    _ /= _ = True
+-}
+
+instance Ser.Serialize (dim O t) => Ser.Serialize (GenericKey dim O t) where
+    get = K1 <$> Ser.get
+    put (K1 d) = Ser.put d
+
+instance Ser.Serialize (dim M t) => Ser.Serialize (GenericKey dim M t) where
+    get = K1 <$> Ser.get
+    put (K1 d) = Ser.put d
+
+instance (Ser.Serialize (GenericKey dim rt tt), Ser.Serialize (dim r t)) => Ser.Serialize (GenericKey dim (r :. rt) (t :. tt)) where
+    get = KN <$> Ser.get <*> Ser.get
+    put (KN d dt) = Ser.put d >> Ser.put dt
+    put (K1 _) = error $ moduleName <> ".GenricKey.put: The impossible happened."
+
+instance Ser.SafeCopy (dim O t) => Ser.SafeCopy (GenericKey dim O t) where
+    getCopy = Ser.contain $ K1 <$> Ser.safeGet
+    putCopy (K1 d) = Ser.contain $ Ser.safePut d
+
+instance Ser.SafeCopy (dim M t) => Ser.SafeCopy (GenericKey dim M t) where
+    getCopy = Ser.contain $ K1 <$> Ser.safeGet
+    putCopy (K1 d) = Ser.contain $ Ser.safePut d
+
+instance (Ser.SafeCopy (GenericKey dim rt tt), Ser.SafeCopy (dim r t)) => Ser.SafeCopy (GenericKey dim (r :. rt) (t :. tt)) where
+    getCopy = Ser.contain $ KN <$> Ser.safeGet <*> Ser.safeGet
+    putCopy (KN d dt) = Ser.contain $ Ser.safePut d >> Ser.safePut dt
+    putCopy (K1 _) = error $ moduleName <> ".GenricKey.putCopy: The impossible happened."
+
+instance Typeable2 (GenericKey dim) where
+    typeOf2 (K1 _) = Data.Data.mkTyConApp (Data.Data.mkTyCon3 "data-store" moduleName "K1") []
+    typeOf2 (KN _ _) = Data.Data.mkTyConApp (Data.Data.mkTyCon3 "data-store" moduleName "KN") []
+
+type  Key = GenericKey  KeyDimension
+type IKey = GenericKey IKeyDimension
+
+instance Show t => Show (Key O t) where
+    show (K1 d) = show d 
+
+instance Show t => Show (Key M t) where
+    show (K1 d) = show d 
+
+instance (Show t, Show (Key rt tt)) => Show (Key (r :. rt) (t :. tt)) where
+    show (KN d k) = show d <> ", " <> show k
+    show (K1 _) = error $ moduleName <> ".Key.show: The impossible happened."
+
+instance Show t => Show (IKey O t) where
+    show (K1 d) = show d 
+
+instance Show t => Show (IKey M t) where
+    show (K1 d) = show d 
+
+instance (Show t, Show (IKey rt tt)) => Show (IKey (r :. rt) (t :. tt)) where
+    show (KN d k) = show d <> ", " <> show k
+    show (K1 _) = error $ moduleName <> ".IKey.show: The impossible happened."
+
+data Index rs ts where
+    IN :: Ord t => !(IndexDimension r t) -> !(Index rt tt) -> Index (r :. rt) (t :. tt)
+    I1 :: Ord t => !(IndexDimension r t) -> Index r t
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (Index O t) where
+    get = I1 <$> Ser.get
+    put (I1 ixd) = Ser.put ixd
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (Index M t) where
+    get = I1 <$> Ser.get
+    put (I1 ixd) = Ser.put ixd
+
+instance (Ord t, Ser.Serialize t, Ser.Serialize (Index rt tt)) => Ser.Serialize (Index (O :. rt) (t :. tt)) where
+    get = IN <$> Ser.get <*> Ser.get
+    put (IN ixd ixt) = Ser.put ixd >> Ser.put ixt
+    put (I1 _) = error $ moduleName <> ".Index.put: The impossible happened (#1)."
+
+instance (Ord t, Ser.Serialize t, Ser.Serialize (Index rt tt)) => Ser.Serialize (Index (M :. rt) (t :. tt)) where
+    get = IN <$> Ser.get <*> Ser.get
+    put (IN ixd ixt) = Ser.put ixd >> Ser.put ixt
+    put (I1 _) = error $ moduleName <> ".Index.put: The impossible happened (#2)."
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (Index O t) where
+    getCopy = Ser.contain $ I1 <$> Ser.safeGet
+    putCopy (I1 ixd) = Ser.contain $ Ser.safePut ixd
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (Index M t) where
+    getCopy = Ser.contain $ I1 <$> Ser.safeGet
+    putCopy (I1 ixd) = Ser.contain $ Ser.safePut ixd
+
+instance (Ord t, Ser.SafeCopy t, Ser.SafeCopy (Index rt tt)) => Ser.SafeCopy (Index (O :. rt) (t :. tt)) where
+    getCopy = Ser.contain $ IN <$> Ser.safeGet <*> Ser.safeGet
+    putCopy (IN ixd ixt) = Ser.contain $ Ser.safePut ixd >> Ser.safePut ixt
+    putCopy (I1 _) = error $ moduleName <> ".Index.putCopy: The impossible happened (#1)."
+
+instance (Ord t, Ser.SafeCopy t, Ser.SafeCopy (Index rt tt)) => Ser.SafeCopy (Index (M :. rt) (t :. tt)) where
+    getCopy = Ser.contain $ IN <$> Ser.safeGet <*> Ser.safeGet
+    putCopy (IN ixd ixt) = Ser.contain $ Ser.safePut ixd >> Ser.safePut ixt
+    putCopy (I1 _) = error $ moduleName <> ".Index.putCopy: The impossible happened (#2)."
+
+instance Typeable2 Index where
+    typeOf2 (I1 _) = Data.Data.mkTyConApp (Data.Data.mkTyCon3 "data-store" moduleName "I1") []
+    typeOf2 (IN _ _) = Data.Data.mkTyConApp (Data.Data.mkTyCon3 "data-store" moduleName "IN") []
+
+instance Show t => Show (Index O t) where
+    show (I1 d) = show d
+
+instance Show t => Show (Index M t) where
+    show (I1 d) = show d
+
+instance (Show t, Show (Index rt tt)) => Show (Index (r :. rt) (t :. tt)) where
+    show (IN d i) = show d <> "\n" <> show i
+    show (I1 _) = error $ moduleName <> ".Index.show: The impossible happened."
+
+data KeyDimension r t where
+    KeyDimensionO :: Ord t =>  t  -> KeyDimension O t
+    KeyDimensionM :: Ord t => [t] -> KeyDimension M t
+    KeyDimensionA :: Auto t => KeyDimension O t
+
+deriving instance Typeable2 KeyDimension
+
+instance Show t => Show (KeyDimension r t) where
+    show (KeyDimensionM ts) = show ts
+    show (KeyDimensionO t)  = show t
+    show  KeyDimensionA     = show "Auto"
+
+data IKeyDimension r t where
+    IKeyDimensionO :: Ord t => t  -> IKeyDimension O t
+    IKeyDimensionM :: Ord t => [t] -> IKeyDimension M t
+
+instance Eq (IKeyDimension r t) where
+    (IKeyDimensionM x) == (IKeyDimensionM y) = x == y
+    (IKeyDimensionO x) == (IKeyDimensionO y) = x == y
+    _ == _ = False
+
+    (IKeyDimensionM x) /= (IKeyDimensionM y) = x /= y
+    (IKeyDimensionO x) /= (IKeyDimensionO y) = x /= y
+    _ /= _ = True    
+
+deriving instance Typeable2 IKeyDimension
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (IKeyDimension O t) where
+    get = IKeyDimensionO <$> Ser.get
+    put (IKeyDimensionO x) = Ser.put x
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (IKeyDimension M t) where
+    get = IKeyDimensionM <$> Ser.get
+    put (IKeyDimensionM x) = Ser.put x
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (IKeyDimension O t) where
+    getCopy = Ser.contain $ IKeyDimensionO <$> Ser.safeGet
+    putCopy (IKeyDimensionO x)  = Ser.contain $ Ser.safePut x
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (IKeyDimension M t) where
+    getCopy = Ser.contain $ IKeyDimensionM <$> Ser.safeGet
+    putCopy (IKeyDimensionM x)  = Ser.contain $ Ser.safePut x
+
+instance Show t => Show (IKeyDimension r t) where
+    show (IKeyDimensionM ts) = show ts
+    show (IKeyDimensionO t)  = show t
+
+data IndexDimension r t where
+    IndexDimensionO :: Ord t
+                    => !(Data.Map.Map t Int)
+                    -> IndexDimension O t
+    
+    IndexDimensionM :: Ord t
+                    => !(Data.Map.Map t Data.IntSet.IntSet)
+                    -> IndexDimension M t
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (IndexDimension O t) where
+    get = IndexDimensionO <$> Ser.get
+    put (IndexDimensionO x) = Ser.put x
+
+instance (Ord t, Ser.Serialize t) => Ser.Serialize (IndexDimension M t) where
+    get = IndexDimensionM <$> Ser.get
+    put (IndexDimensionM x) = Ser.put x
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (IndexDimension O t) where
+    getCopy = Ser.contain $ IndexDimensionO <$> Ser.safeGet
+    putCopy (IndexDimensionO x)  = Ser.contain $ Ser.safePut x
+
+instance (Ord t, Ser.SafeCopy t) => Ser.SafeCopy (IndexDimension M t) where
+    getCopy = Ser.contain $ IndexDimensionM <$> Ser.safeGet
+    putCopy (IndexDimensionM x)  = Ser.contain $ Ser.safePut x
+
+instance Show t => Show (IndexDimension r t) where
+    show (IndexDimensionM m) = show $ map (\(k, vs) -> (k, Data.IntSet.toList vs)) $ Data.Map.toList m
+    show (IndexDimensionO m) = show $ Data.Map.toList m
+
+class GetDimension n a where
+    getDimension :: n -> a -> RawDimensionType n a
+
+instance GetDimension Z (Index O t) where
+    getDimension _ (I1 ixd) = ixd
+
+instance GetDimension Z (Index M t) where
+    getDimension _ (I1 ixd) = ixd
+
+instance GetDimension Z (Index (r :. rt) (t :. tt)) where
+    getDimension _ (IN ixd _) = ixd
+    getDimension _ (I1 _) = error $ moduleName <> ".Index.getDimension: The impossible happened."
+
+instance GetDimension n (Index rt tt) => GetDimension (S n) (Index (r :. rt) (t :. tt)) where
+    getDimension (S n) (IN _ ixt) = getDimension n ixt
+    getDimension _ (I1 _) = error $ moduleName <> ".Index.getDimension: The impossible happened."
+
+data TT
+data FF
+
+type family   EmptyProxyIsSpecial t :: *
+type instance EmptyProxyIsSpecial Int = TT
+
+class Empty a where
+    empty :: a
+
+class EmptyProxy flag a where
+    emptyProxy :: flag -> a
+
+instance Ord t => Empty (Index O t) where
+    empty = I1 (IndexDimensionO Data.Map.empty)
+
+instance Ord t => Empty (Index M t) where
+    empty = I1 (IndexDimensionM Data.Map.empty)
+
+instance (Ord t, Empty (Index rt tt)) => Empty (Index (O :. rt) (t :. tt)) where
+    empty = IN (IndexDimensionO Data.Map.empty) empty
+
+instance (Ord t, Empty (Index rt tt)) => Empty (Index (M :. rt) (t :. tt)) where
+    empty = IN (IndexDimensionM Data.Map.empty) empty
+
+instance Empty (Index irs ts) => Empty (Store tag krs irs ts e) where
+    empty = Store
+        { storeV = Data.IntMap.empty
+        , storeI = empty
+        , storeNID = 0
+        }
+    {-# INLINE empty #-}
+
+-- | Data type for creating tuples, it is used to:
+--
+-- * Create type-level tuples of relation tags for relation specification of
+-- the key and the index of the store.
+--
+-- > M :. O :. O :. M
+--
+-- * Create type-level tuples of types for type specification of the key
+-- and index of the store.
+--
+-- > Int :. Double :. String :. String
+--
+-- * Create value-level tuples to return raw key (with resolved
+-- auto-increment dimensions).
+--
+-- > [1, 2, 3] :. 3.5 :. "Foo" :. ["Bar1", "Bar2"]
+data h :. t = h :. t
+infixr 3 :.
+
+
+-- NFDATA INSTANCES
+
+instance (NFData e, NFData (IKey krs ts), NFData (Index irs ts)) => NFData (Store tag krs irs ts e) where
+    rnf (Store ke ix nid) = rnf ke `seq` rnf ix `seq` rnf nid
+
+instance NFData t => NFData (IndexDimension r t) where
+    rnf (IndexDimensionO m) = rnf m
+    rnf (IndexDimensionM m) = rnf m
+
+instance NFData t => NFData (Index O t) where
+    rnf (I1 kd) = rnf kd
+     
+instance NFData t => NFData (Index M t) where
+    rnf (I1 kd) = rnf kd
+
+instance (NFData t, NFData (Index rt tt)) => NFData (Index (r :. rt) (t :. tt)) where
+    rnf (IN kd kt) = rnf kd `seq` rnf kt
+    rnf (I1 _) = error "Impossible! (Index NFData)"
+
+instance NFData t => NFData (IKeyDimension r t) where
+    rnf (IKeyDimensionO x) = rnf x
+    rnf (IKeyDimensionM x) = rnf x
+
+instance NFData t => NFData (IKey O t) where
+    rnf (K1 kd) = rnf kd
+     
+instance NFData t => NFData (IKey M t) where
+    rnf (K1 kd) = rnf kd
+
+instance (NFData t, NFData (IKey rt tt)) => NFData (IKey (r :. rt) (t :. tt)) where
+    rnf (KN kd kt) = rnf kd `seq` rnf kt
+    rnf (K1 _) = error "Impossible! (IKey NFData)"
+
+instance (NFData a, NFData b) => NFData (a :. b) where
+    rnf (a :. b) = rnf a `seq` rnf b
+
+
diff --git a/src/Data/Store/Lens.hs b/src/Data/Store/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Lens.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Data.Store.Lens
+( With(..)
+) where
+
+--------------------------------------------------------------------------------
+import qualified Control.Lens
+--------------------------------------------------------------------------------
+import           Data.Monoid 
+import           Data.Functor.Identity
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type     as I
+import qualified Data.Store.Internal.Function as I
+import qualified Data.Store.Selection         as I (IsSelection(resolve))
+import qualified Data.Store                   as I ()
+--------------------------------------------------------------------------------
+
+class With sel where
+    with :: I.Empty (I.Index irs ts) 
+         => sel tag krs irs ts -> Control.Lens.Lens' (I.Store tag krs irs ts v)
+                                                     (I.Store tag krs irs ts v)
+
+instance I.IsSelection sel => With sel where
+    with sel tr old =
+      fmap (mappend (runIdentity $! I.genericUpdateWithKey I.indexInsertID'' (\_ _ -> Nothing) ids old))
+           (tr (I.genericSubset ids old))
+      where
+        ids = I.resolve sel old
+
diff --git a/src/Data/Store/Selection.hs b/src/Data/Store/Selection.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Selection.hs
@@ -0,0 +1,230 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
+
+module Data.Store.Selection
+( (.<)
+, (.<=)
+, (.>)
+, (.>=)
+, (./=)
+, (.==)
+, (.&&)
+, (.||)
+, not
+, all
+, all1D
+, any
+, any1D
+, IsSelection(..)
+, Selection
+) where
+
+--------------------------------------------------------------------------------
+import           Prelude hiding (not, all, any)
+--------------------------------------------------------------------------------
+import           Data.Monoid ((<>))
+import qualified Data.IntSet
+import qualified Data.List
+import qualified Data.IntMap.Strict as Data.IntMap
+import qualified Data.Map.Strict    as Data.Map
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type as I
+--------------------------------------------------------------------------------
+
+moduleName :: String
+moduleName = "Data.Store.Selection"
+
+-- INTERFACE
+
+infix  4  .==, ./=, .<, .<=, .>=, .>
+infixr 3  .&&
+infixr 2  .||
+
+-- | The expression (@not' sel@) is a selection that includes all values
+-- except those that match the selection @sel@. 
+not :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
+not = SelectionNot
+{-# INLINE not #-}
+
+-- | Selection that matches the intersection of all the selections in the
+-- list or everything if the list is empty.
+all :: [Selection tag krs irs ts] -> Selection tag krs irs ts
+all []  = error $ moduleName <> ".all: empty list."
+all [s] = s
+all (s:rest) = Data.List.foldl' (.&&) s rest -- this way we do not have to intersect with "everything"
+{-# INLINE all #-}
+
+-- | The expression (@'Data.Store.Selection.all1D' d ss@) is equivalent to (@'Data.Store.Selection.all'' $ map ($ d) ss@).
+all1D :: (tag, n) -> [(tag, n) -> Selection tag krs irs ts] -> Selection tag krs irs ts
+all1D _ [] = error $ moduleName <> ".all1D: empty list."
+all1D d [h] = h d
+all1D d (h:rest) = Data.List.foldl' (\acc f -> acc .&& f d) (h d) rest -- this way we do not have to intersect with "everything"
+{-# INLINE all1D #-}
+
+-- | Selection that matches the union of all the selections in the
+-- list or nothing if the list is empty.
+any :: [Selection tag krs irs ts] -> Selection tag krs irs ts
+any [] = error $ moduleName <> ".any: empty list."
+any (x:xs) = Data.List.foldl' (.||) x xs
+{-# INLINE any #-}
+
+-- | The expression (@'Data.Store.Selection.any1D' d ss@) is equivalent to (@'Data.Store.Selection.any'' $ map ($ d) ss@).
+any1D :: (tag, n) -> [(tag, n) -> Selection tag krs irs ts] -> Selection tag krs irs ts
+any1D _ [] = error $ moduleName <> ".any1D: empty list."
+any1D d (x:xs) = Data.List.foldl' (\acc f -> acc .|| f d) (x d) xs
+{-# INLINE any1D #-}
+
+-- | The expression (@sDim .< c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k < c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(log n + k)/
+(.<) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(.<) (_, n) = SelectionType . SelectionDimension n (Condition True False False)
+{-# INLINE (.<) #-}
+
+-- | The expression (@sDim .<= c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k <= c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(log n + k)/
+(.<=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(.<=) (_, n) = SelectionType . SelectionDimension n (Condition True True False)
+{-# INLINE (.<=) #-}
+
+-- | The expression (@sDim .> c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k > c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(log n + k)/
+(.>) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(.>) (_, n) = SelectionType . SelectionDimension n (Condition False False True)
+{-# INLINE (.>) #-}
+
+-- | The expression (@sDim .>= c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k >= c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(log n + k)/
+(.>=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(.>=) (_, n) = SelectionType . SelectionDimension n (Condition False True True)
+{-# INLINE (.>=) #-}
+
+-- | The expression (@sDim ./= c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k /= c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(n)/
+(./=) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(./=) (_, n) = SelectionType . SelectionDimension n (Condition True False True)
+{-# INLINE (./=) #-}
+
+-- | The expression (@sDim .== c@) is a selection that includes value
+-- @x@ if and only if it is indexed in the @sDim@ dimension with a key @k@
+-- such that @k == c@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(log n)/
+(.==) :: I.GetDimension n (I.Index irs ts) => (tag, n) -> I.DimensionType n irs ts -> Selection tag krs irs ts
+(.==) (_, n) = SelectionType . SelectionDimension n (Condition False True False)
+{-# INLINE (.==) #-}
+
+-- | The expression (@s1 .&& s2@) is a selection that includes the
+-- intersection of the selections @s1@ and @s2@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(c(s1) + c(s2) + s(s1) + s(s2)/
+(.&&) :: (IsSelection s1, IsSelection s2)
+      => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
+(.&&) = SelectionA
+{-# INLINE (.&&) #-}
+
+-- | The expression (@s1 .|| s2@) is a selection that includes the
+-- union of the selections @s1@ and @s2@.
+--
+-- Complexity of @'Data.Store.Selection.resolve'@: /O(c(s1) + c(s2) + s(s1) + s(s2)/
+(.||) :: (IsSelection s1, IsSelection s2)
+      => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
+(.||) = SelectionO
+{-# INLINE (.||) #-}
+
+-- IMPLEMENTATION
+
+instance IsSelection Selection where
+    resolve (SelectionType sel) s = resolve sel s
+    resolve (SelectionA s1 s2) s = Data.IntSet.intersection (resolve s1 s) (resolve s2 s)
+    resolve (SelectionO s1 s2) s = Data.IntSet.union (resolve s1 s) (resolve s2 s)
+    resolve (SelectionNot sel) s@(I.Store vs _ _) =
+        Data.IntSet.difference (Data.IntMap.keysSet vs) (resolve sel s)
+    {-# INLINE resolve #-}
+
+instance IsSelection (SelectionDimension n) where
+    resolve = resolveSD
+    {-# INLINE resolve #-}
+
+resolveSD :: forall tag n krs irs ts v . SelectionDimension n tag krs irs ts 
+          -> I.Store tag krs irs ts v
+          -> Data.IntSet.IntSet
+resolveSD (SelectionDimension _ (Condition False False False) _) _ = {-# SCC "resolveSD" #-} Data.IntSet.empty
+resolveSD (SelectionDimension _ (Condition True True True) _) (I.Store vs _ _) = {-# SCC "resolveSD" #-}  Data.IntSet.fromList $ Data.IntMap.keys vs
+resolveSD (SelectionDimension n (Condition lt eq gt) v) (I.Store _ ix _) = {-# SCC "resolveSD" #-} 
+    go $! I.getDimension n ix
+    where
+      go (I.IndexDimensionO m) = m `seq` case Data.Map.splitLookup v m of
+          (lk, ek, gk) -> (if lt then trO lk else Data.IntSet.empty) <>
+                          (if eq then trMaybeO ek else Data.IntSet.empty) <>
+                          (if gt then trO gk else Data.IntSet.empty)                         
+      go (I.IndexDimensionM m) = m `seq` case Data.Map.splitLookup v m of
+          (lk, ek, gk) -> (if lt then trM lk else Data.IntSet.empty) <>
+                          (if eq then trMaybeM ek else Data.IntSet.empty) <>
+                          (if gt then trM gk else Data.IntSet.empty)
+      {-# INLINEABLE go #-}
+
+      trO :: Data.Map.Map k Int -> Data.IntSet.IntSet
+      trO xs = {-# SCC "resolveSD.trO" #-} Data.Map.foldl' ins Data.IntSet.empty xs
+        where ins acc i = Data.IntSet.insert i acc
+      {-# INLINE trO #-}
+
+      trMaybeO :: Maybe Int -> Data.IntSet.IntSet
+      trMaybeO (Just x) = Data.IntSet.singleton x
+      trMaybeO _ = Data.IntSet.empty
+      {-# INLINE trMaybeO #-}
+
+      trM :: Data.Map.Map k Data.IntSet.IntSet -> Data.IntSet.IntSet
+      trM = Data.Map.foldl' Data.IntSet.union Data.IntSet.empty
+      {-# INLINE trM #-}
+
+      trMaybeM :: Maybe Data.IntSet.IntSet -> Data.IntSet.IntSet
+      trMaybeM (Just x) = x
+      trMaybeM _ = Data.IntSet.empty
+      {-# INLINE trMaybeM #-}
+{-# INLINE resolveSD #-}
+
+-- | TYPE
+
+data SelectionDimension n tag krs irs ts where
+    SelectionDimension :: I.GetDimension n (I.Index irs ts)
+                       => n
+                       -> Condition
+                       -> I.DimensionType n irs ts
+                       -> SelectionDimension n tag krs irs ts
+
+data Selection tag krs irs ts where
+    SelectionType :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts    
+
+    SelectionA :: (IsSelection s1, IsSelection s2)
+               => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
+
+    SelectionO :: (IsSelection s1, IsSelection s2)
+               => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
+
+    SelectionNot :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
+
+data Condition = Condition !Bool !Bool !Bool
+
+class IsSelection sel where
+    resolve :: sel tag krs irs ts -> I.Store tag krs irs ts v -> Data.IntSet.IntSet
+   
diff --git a/src/Data/Store/Storable.hs b/src/Data/Store/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Store/Storable.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Data.Store.Storable
+( Storable(..)
+
+, insert
+, insert'
+, updateWithKey
+, updateWithKey'
+, update
+, update'
+, fromList
+, fromList'
+) where
+
+--------------------------------------------------------------------------------
+import qualified Data.Store.Internal.Type as I 
+import qualified Data.Store as S 
+import qualified Data.Store.Selection as S (IsSelection()) 
+--------------------------------------------------------------------------------
+
+-- | This type-class facilitates the common use case where the key under
+-- which given values is to be indexed can be derived from the value.
+--
+-- Example:
+--
+-- The @Storable@ type-class instance for our @Content@ data type would look
+-- like this:
+--
+-- > instance Storable Content where
+-- >     type StoreKRS Content = O         :. O      :. O      :. M      :. O 
+-- >     type StoreIRS Content = O         :. O      :. M      :. M      :. M
+-- >     type StoreTS  Content = ContentID :. String :. String :. String :. Double
+-- >
+-- >     key (Content cn cb cts cr) = 
+-- >         S.dimA .: S.dimO cn .: S.dimO cb .: S.dimM cts .:. S.dimO cr
+class Storable v where
+    type StoreKRS t :: *
+    type StoreIRS t :: *
+    type StoreTS  t :: *
+    
+    key :: v -> S.Key (StoreKRS v) (StoreTS v)
+
+-- | See @'Data.Store.insert'@.
+insert :: Storable v
+       => v
+       -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+       -> Maybe (S.RawKey (StoreKRS v) (StoreTS v), S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v)
+insert v = S.insert (key v) v
+{-# INLINE insert #-}
+
+-- | See @'Data.Store.insert''@.
+insert' :: Storable v
+        => v
+        -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+        -> (S.RawKey (StoreKRS v) (StoreTS v), S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v)
+insert' v = S.insert' (key v) v
+{-# INLINE insert' #-}
+
+-- | See @'Data.Store.update'@.
+update :: (Storable v, S.IsSelection sel)
+       => (v -> Maybe v)
+       -> sel tag (StoreKRS v) (StoreIRS v) (StoreTS v)
+       -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+       -> Maybe (S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v)
+update tr = S.update (maybe Nothing (\v -> Just (v, Just $! key v)) . tr)
+{-# INLINE update #-}
+
+-- | See @'Data.Store.update''@.
+update' :: (Storable v, S.IsSelection sel)
+        => (v -> Maybe v)
+        -> sel tag (StoreKRS v) (StoreIRS v) (StoreTS v)
+        -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+        -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+update' tr = S.update' (maybe Nothing (\v -> Just (v, Just $! key v)) . tr)
+{-# INLINE update' #-}
+
+-- | See @'Data.Store.updateWithKey'@.
+updateWithKey :: (Storable v, S.IsSelection sel)
+              => (S.RawKey (StoreKRS v) (StoreTS v) -> v -> Maybe v)
+              -> sel tag (StoreKRS v) (StoreIRS v) (StoreTS v)
+              -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+              -> Maybe (S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v)
+updateWithKey tr = S.updateWithKey (\rk vv -> maybe Nothing (\v -> Just (v, Just $! key v)) $ tr rk vv)
+{-# INLINE updateWithKey #-}
+
+-- | See @'Data.Store.updateWithKey''@.
+updateWithKey' :: (Storable v, S.IsSelection sel)
+               => (S.RawKey (StoreKRS v) (StoreTS v) -> v -> Maybe v)
+               -> sel tag (StoreKRS v) (StoreIRS v) (StoreTS v)
+               -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+               -> S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+updateWithKey' tr = S.updateWithKey' (\rk vv -> maybe Nothing (\v -> Just (v, Just $! key v)) $ tr rk vv)
+{-# INLINE updateWithKey' #-}
+
+-- | See @'Data.Store.fromList'@.
+fromList :: (I.Empty (I.Index (StoreIRS v) (StoreTS v)), Storable v)
+         => [v]
+         -> Maybe (S.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v)
+fromList = S.fromList . map (\v -> (key v, v))
+{-# INLINE fromList #-}
+
+-- | See @'Data.Store.fromList''@.
+fromList' :: (I.Empty (I.Index (StoreIRS v) (StoreTS v)), Storable v)
+          => [v]
+          -> I.Store tag (StoreKRS v) (StoreIRS v) (StoreTS v) v
+fromList' = S.fromList' . map (\v -> (key v, v))
+{-# INLINE fromList' #-}
+
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,14 @@
+module Main
+( main
+) where
+
+------------------------------------------------------------------------------
+import Test.Framework (defaultMain, testGroup)
+------------------------------------------------------------------------------
+import qualified Test.Data.Store01
+------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain
+    [ testGroup "Data.Store01" Test.Data.Store01.tests
+    ]
diff --git a/tests/Test/Data/Store01.hs b/tests/Test/Data/Store01.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test/Data/Store01.hs
@@ -0,0 +1,324 @@
+{-# LANGUAGE TypeOperators #-}
+
+module Test.Data.Store01
+( tests
+) where
+
+--------------------------------------------------------------------------------
+import Control.Arrow
+import Control.Applicative
+--------------------------------------------------------------------------------
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+--------------------------------------------------------------------------------
+import qualified Data.List as L
+import           Data.Maybe
+import           Data.Proxy
+import qualified Data.Foldable
+import qualified Data.Set
+import qualified Data.IntSet
+--------------------------------------------------------------------------------
+import qualified Data.Store as S
+import           Data.Store (M, O, (.:), (.:.), (:.)(..), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||))
+--------------------------------------------------------------------------------
+
+data D = D
+    { dOM :: Int
+    , dMO :: [Int]
+    , dMM :: [Int]
+    } deriving (Eq, Ord, Show)
+
+type DID = Int
+
+data DStoreTag = DStoreTag
+
+type DSTS  = DID :. Int :. Int :. Int
+type DSKRS = O       :. O   :. M   :. M 
+type DSIRS = O       :. M   :. O   :. M 
+type DS = S.Store DStoreTag DSKRS DSIRS DSTS D
+type DSKey = S.Key DSKRS DSTS
+type DSSelection = S.Selection DStoreTag DSKRS DSIRS DSTS
+
+sOO :: (DStoreTag, S.N0)
+sOO = (DStoreTag, S.n0)
+
+sOM :: (DStoreTag, S.N1)
+sOM = (DStoreTag, S.n1)
+
+sMO :: (DStoreTag, S.N2)
+sMO = (DStoreTag, S.n2)
+
+sMM :: (DStoreTag, S.N3)
+sMM = (DStoreTag, S.n3)
+
+makeKey :: Int -> Int -> [Int] -> [Int] -> DSKey
+makeKey oo om mo mm = 
+    S.dimO oo .: S.dimO om .: S.dimM mo .:. S.dimM mm
+
+vkey :: D -> DSKey
+vkey (D om mo mm) =  
+    S.dimA .: S.dimO om .: S.dimM mo .:. S.dimM mm
+
+
+vkey' :: Int -> D -> DSKey
+vkey' i (D om mo mm) = 
+    S.dimO i .: S.dimO om .: S.dimM mo .:. S.dimM mm
+
+tests :: [Test]
+tests =
+    [ testProperty "insert1" prop_insert1
+    , testProperty "insert2" prop_insert2
+   
+    , testProperty "insert'1" prop_insert'1
+
+    , testProperty "lookup1" prop_lookup1
+    
+    , testProperty "update1" prop_update1
+    , testProperty "update2" prop_update2
+    , testProperty "update3" prop_update3
+    ]
+
+-- | Tests insert (auto-incrementation) #1.
+prop_insert1 (D om mo mm) =
+    case S.insert (vkey v) v emptyS of
+      Just (i :. _, store) -> (i == minBound) && (S.size store == 1)
+      _ -> False
+
+    where
+      emptyS :: DS
+      emptyS = S.empty
+
+      v = D om (L.nub mo) (L.nub mm)
+
+-- | Tests insert (auto-incrementation) #2.
+prop_insert2 = ids == map fst inserts
+    where
+      (i0 :. _, s0) = fromJust $ S.insert (vkey $ mval 0) (mval 0) S.empty
+
+      inserts :: [(Int, DS)]
+      inserts =
+        foldl (\acc@((_, s') : _) v -> let (i :. _, s) = fromJust $ S.insert (vkey v) v s'
+                                       in  (i, s) : acc
+              ) [(i0, s0)] ds
+
+      ids :: [Int]
+      ids = reverse . take 100 $ iterate succ minBound
+
+      ds :: [D]
+      ds = map mval [1..99]
+
+      mval :: Int -> D
+      mval i = D i [i] [i]
+
+-- | Tests insert' (deleting collisions)
+prop_insert'1 xs =
+  (Data.Set.fromList (S.elements store1) == Data.Set.fromList (S.elements store2)) &&
+  checkLookup sOO oos &&
+  checkLookup sOM oms &&
+  checkLookup sMO mos &&
+  checkLookup sMM mms
+  where
+    lookupSet :: DSSelection -> DS -> Data.Set.Set D
+    lookupSet sel s = Data.Set.fromList $ map snd $ S.lookup sel s
+
+    checkLookup dim xs =
+      all (\x -> lookupSet (dim .== x) store1 == lookupSet (dim .== x) store2) xs
+
+    kes :: [(DSKey, D)]
+    kes = zipWith (\i x -> (vkey' i x, x)) [0 ..] xs
+
+    oos :: [Int]
+    oos = [ 0 .. 5000 ]
+
+    oms :: [Int]
+    oms = Data.IntSet.toList $
+      foldr (\(D om _ _) acc -> Data.IntSet.insert om acc) Data.IntSet.empty xs
+
+    mos :: [Int]
+    mos = Data.IntSet.toList $
+      foldr (\(D _ mo _) acc -> Data.IntSet.union (Data.IntSet.fromList mo) acc) Data.IntSet.empty xs
+
+    mms :: [Int]
+    mms = Data.IntSet.toList $
+      foldr (\(D _ _ mm) acc -> Data.IntSet.union (Data.IntSet.fromList mm) acc) Data.IntSet.empty xs
+
+    store1 :: DS
+    store1 = S.fromList' kes
+    
+    store2 :: DS
+    store2 = foldl (\acc (k, x) -> snd $ S.insert' k x acc) store1 kes
+
+-- | Tests insert, lookup (EQ, LT, GT, NEQ) #1.
+prop_lookup1 = byOO_EQ  && byOM_EQ  && byMO_EQ  && byMM_EQ  &&
+               byOO_LT  && byOM_LT  && byMO_LT  && byMM_LT  &&
+               byOO_GT  && byOM_GT  && byMO_GT  && byMM_GT  &&
+               byOO_NEQ && byOM_NEQ && byMO_NEQ && byMM_NEQ
+    where
+      byOO_EQ :: Bool
+      byOO_EQ = all (\r -> length r == 1) $
+        map (\k -> S.lookup (sOO .== k) store) oos
+
+      byOM_EQ :: Bool
+      byOM_EQ = all (\r -> length r == 50) $
+        map (\k -> S.lookup (sOM .== k) store) oms
+
+      byMO_EQ :: Bool
+      byMO_EQ = all (\r -> length r == 1) $
+        map (\k -> S.lookup (sMO .== k) store) mos
+
+      byMM_EQ :: Bool
+      byMM_EQ = all (\(k, r) -> length r == (100 - k)) $
+        map (\k -> (k, S.lookup (sMM .== k) store)) mms
+
+      byOO_LT :: Bool
+      byOO_LT = all (\(k, r) -> length r == (k + minBound)) $
+        map (\k -> (k, S.lookup (sOO .< k) store)) oos
+
+      byOM_LT :: Bool
+      byOM_LT = all (\(k, r) -> length r == (k * 50)) $
+        map (\k -> (k, S.lookup (sOM .< k) store)) oms
+
+      byMO_LT :: Bool
+      byMO_LT = all (\(k, r) -> length r == k) $
+        map (\k -> (k, S.lookup (sMO .< k) store)) mos
+
+      byMM_LT :: Bool
+      byMM_LT = all (\(k, r) -> length r == (if k == 0 then 0 else 100)) $
+        map (\k -> (k, S.lookup (sMM .< k) store)) mms
+
+      byOO_GT :: Bool
+      byOO_GT = all (\(k, r) -> length r == (99 - k + minBound)) $
+        map (\k -> (k, S.lookup (sOO .> k) store)) oos
+
+      byOM_GT :: Bool
+      byOM_GT = all (\(k, r) -> length r == ((1 - k) * 50)) $
+        map (\k -> (k, S.lookup (sOM .> k) store)) oms
+
+      byMO_GT :: Bool
+      byMO_GT = all (\(k, r) -> length r == (99 - k)) $
+        map (\k -> (k, S.lookup (sMO .> k) store)) mos
+
+      byMM_GT :: Bool
+      byMM_GT = all (\(k, r) -> length r == (99 - k)) $
+        map (\k -> (k, S.lookup (sMM .> k) store)) mms
+      
+      byOO_NEQ :: Bool
+      byOO_NEQ = all (\(k, r) -> length r == 99) $
+        map (\k -> (k, S.lookup (sOO ./= k) store)) oos
+
+      byOM_NEQ :: Bool
+      byOM_NEQ = all (\(k, r) -> length r == 50) $
+        map (\k -> (k, S.lookup (sOM ./= k) store)) oms
+
+      byMO_NEQ :: Bool
+      byMO_NEQ = all (\(k, r) -> length r == 99) $
+        map (\k -> (k, S.lookup (sMO ./= k) store)) mos
+
+      byMM_NEQ :: Bool
+      byMM_NEQ = all (\(k, r) -> length r == (if k == 0 then 99 else 100)) $
+        map (\k -> (k, S.lookup (sMM ./= k) store)) mms
+      
+      store :: DS
+      store = foldl (\s v -> snd . fromJust $ S.insert (vkey v) v s) S.empty ds
+
+      ds :: [D]
+      ds = map mval [0..99]
+
+      mval :: Int -> D
+      mval i = D (i `mod` 2) [i] [0..i]
+
+      -- Every key in this list corresponds to exactly 1 d.
+      oos :: [Int]
+      oos = take 100 $ iterate succ minBound
+
+      -- Every key in this list corresponds to exactly 50 ds.
+      oms :: [Int]
+      oms = [0, 1]
+
+      -- Every key in this list corresponds to exactly 1 d.
+      mos :: [Int]
+      mos = [0..99]
+
+      -- Every key 'k' in this list corresponds to exactly '100 - k'
+      -- ds.
+      mms :: [Int]
+      mms = [0..99]
+
+-- | Tests insert, delete #1
+prop_update1 = deleteMM
+    where
+      deleteMM :: Bool
+      deleteMM = all (\(k, s, l) -> S.size s == k && length l == 0) $
+        map (\k -> let res = S.delete (sMM .== k) store
+                   in  (k, res, S.lookup (sMM .== k) res)
+            ) mms  
+
+      store :: DS
+      store = foldl (\s v -> snd . fromJust $ S.insert (vkey v) v s) S.empty ds
+
+      ds :: [D]
+      ds = map mval [0..99]
+
+      mval :: Int -> D
+      mval i = D (i `mod` 2) [i] [0..i]
+      
+      mms :: [Int]
+      mms = [0..99]
+
+-- | Tests insert, delete #2
+prop_update2 = test1
+    where
+      test1 :: Bool
+      test1 = lookupRes1 == [v2] &&
+              lookupRes2 == [v3] &&
+              S.size res == 2
+        where
+          res = S.delete ((sOM .== 1) .&& (sMM .== 1)) store
+          lookupRes1 = map snd $ S.lookup (sOM .== 1) res
+          lookupRes2 = map snd $ S.lookup (sMM .== 1) res
+
+      store :: DS
+      store = foldl (\s v -> snd . fromJust $ S.insert (vkey v) v s) S.empty ds
+
+      ds :: [D]
+      ds = [v1, v2, v3]
+
+      v1 = D 1 [1] [1]
+      v2 = D 1 [2] [2, 3]
+      v3 = D 2 [3] [1, 2]
+  
+-- | Tests insert, update (changing key)
+prop_update3 = test1
+    where
+      test1 :: Bool
+      test1 = lookupRes1 == [v2] &&
+              lookupRes2 == [v3] &&
+              lookupRes3 == [v1] &&
+              lookupRes4 == [v1] &&
+              lookupRes5 == [v1] &&
+              S.size res == 3
+        where
+          res = fromJust $ S.update (\v -> Just (v, Just $ makeKey 0 0 [0] [0])) (sOO .== minBound) store
+          lookupRes1 = map snd $ S.lookup (sOM .== 1) res
+          lookupRes2 = map snd $ S.lookup (sMM .== 1) res
+          lookupRes3 = map snd $ S.lookup (sOM .== 0) res
+          lookupRes4 = map snd $ S.lookup (sMO .== 0) res
+          lookupRes5 = map snd $ S.lookup (sMM .== 0) res
+
+      store :: DS
+      store = foldl (\s v -> snd . fromJust $ S.insert (vkey v) v s) S.empty ds
+
+      ds :: [D]
+      ds = [v1, v2, v3]
+
+      v1 = D 1 [1] [1]
+      v2 = D 1 [2] [2, 3]
+      v3 = D 2 [3] [1, 2]
+
+--------------------------------------------------------------------------------
+-- | QuickCheck machinery.
+
+instance Arbitrary D where
+    arbitrary = (\(om, mo, mm) -> D om (L.nub mo) (L.nub mm)) <$> arbitrary
+