hmemdb 0.2.0.4 → 0.3.0.0

raw patch · 17 files changed

+452/−768 lines, 17 filesdep +monad-stmdep −TypeComposePVP ok

version bump matches the API change (PVP)

Dependencies added: monad-stm

Dependencies removed: TypeCompose

API changes (from Hackage documentation)

Files

• hmemdb.cabal +2/−17
• src/Data/HMemDb.hs +450/−48
• src/Data/HMemDb/Bin.hs +0/−51
• src/Data/HMemDb/Binary.hs +0/−8
• src/Data/HMemDb/CreateTable.hs +0/−61
• src/Data/HMemDb/ForeignKeys.hs +0/−49
• src/Data/HMemDb/KeyBackends.hs +0/−80
• src/Data/HMemDb/MapTVar.hs +0/−13
• src/Data/HMemDb/Persistence.hs +0/−46
• src/Data/HMemDb/RefContainer.hs +0/−20
• src/Data/HMemDb/RefConverter.hs +0/−25
• src/Data/HMemDb/References.hs +0/−25
• src/Data/HMemDb/Specs.hs +0/−117
• src/Data/HMemDb/TableVarId.hs +0/−22
• src/Data/HMemDb/TableVars.hs +0/−62
• src/Data/HMemDb/Tables.hs +0/−92
• src/Data/HMemDb/Utils.hs +0/−32

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hmemdb
-version:             0.2.0.4
+version:             0.3.0.0
 synopsis:            In-memory relational database
 description:         Library that provides a sort of relational database in memory (which could be saved to the disk, however). Very untested.
 license:             BSD3
@@ -16,20 +16,5 @@ 
 library
   exposed-modules:     Data.HMemDb
-  other-modules:       Data.HMemDb.Bin,
-                       Data.HMemDb.Binary,
-                       Data.HMemDb.CreateTable, 
-                       Data.HMemDb.ForeignKeys,
-                       Data.HMemDb.KeyBackends,
-                       Data.HMemDb.MapTVar,
-                       Data.HMemDb.Persistence,
-                       Data.HMemDb.RefContainer, 
-                       Data.HMemDb.RefConverter, 
-                       Data.HMemDb.References, 
-                       Data.HMemDb.Specs, 
-                       Data.HMemDb.Tables,
-                       Data.HMemDb.TableVarId,
-                       Data.HMemDb.TableVars,
-                       Data.HMemDb.Utils
-  build-depends:       base ==4.6.*, TypeCompose ==0.9.*, transformers ==0.3.*, stm ==2.4.*, containers ==0.5.*, binary ==0.5.*
+  build-depends:       base ==4.6.*, transformers ==0.3.*, stm ==2.4.*, containers ==0.5.*, binary ==0.5.*, monad-stm
   hs-source-dirs:      src

@@ -1,48 +1,450 @@-{-# LANGUAGE GADTs, KindSignatures, TypeOperators #-}--- | This library allows one to create mutable (but thread-safe)--- lists of values and access them quickly--- with certain automatically updated indices (foreign keys).-module Data.HMemDb-    (-     MS, GS, SP,--- * Tables-     Table, foldTable_,-     TableVar, TableVarS,-     tableVarTarget,-     forTV,-     deleteTV, modifyTV, readTV,-     selectAll,-     ForeignKey, keyTarget,--- * Ids-     TableVarId, idToVar, varToId,--- * Specs-     FullSpec(FullSpec, keySpec, tabSpec),--- ** Table specs-     TableSpec, ColSpec, val, mval, key, tref,--- ** Key specs-     KeySpec, unique, nonunique,--- * Creating tables-     createTable,-     Keys(Keys), RefContainer, IsKeySpec, (:+:)((:+:)),-     CreateTable,--- * Basic operations-     insert, select, delete, update,--- * Serialization-     fillTable, putTable,-    )-where-import Data.HMemDb.Binary (GS, SP)-import Data.HMemDb.CreateTable (CreateTable, IsKeySpec, createTable)-import Data.HMemDb.ForeignKeys (ForeignKey, delete, keyTarget, select, update)-import Data.HMemDb.MapTVar (MS)-import Data.HMemDb.Persistence (fillTable, putTable)-import Data.HMemDb.RefContainer (RefContainer)-import Data.HMemDb.Specs-    (ColSpec, FullSpec(FullSpec, keySpec, tabSpec),-     Keys(Keys), KeySpec, TableSpec,-     key, mval, nonunique, tref, val, unique, (:+:)((:+:)))-import Data.HMemDb.Tables (Table, foldTable_)-import Data.HMemDb.TableVarId (TableVarId, idToVar, varToId)-import Data.HMemDb.TableVars-    (TableVar, TableVarS,-     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget)+{-# LANGUAGE EmptyDataDecls, GADTs, KindSignatures, Rank2Types, TypeOperators #-}
+-- | Tables of values and keys for that tables.
+--
+-- Each value in the table may be accompanied with references to other tables.
+module Data.HMemDb
+    (
+     MS,
+     Multitude, Single, Multiple,
+     Table, Key,
+     TableVarU, TableVar, TableVars, fromList, toList, readVar, readRefs,
+     TableRef, only, some,
+     KeySpec, single, multiple, single_, multiple_,
+     RefsC, Refs (Refs), RefsComponent, Ref, (:&:)((:&:)),
+     KeysC, Keys (Keys), KeysComponent, KeyRef, (:+:)((:+:)),
+     Spec (Spec, sRefs, sKeys),
+     Created (Created, cTable, cKeys),
+     createTable, select, select_, insert, update, update_, delete,
+     getTable, getTable_, getTable__,
+     putTable, putTable_, putTable__
+    ) where
+import Control.Concurrent.STM (STM, TVar, modifyTVar', newTVar, readTVar, writeTVar)
+import Control.Monad (forM, forM_, guard, liftM, liftM2, replicateM)
+import Control.Monad.STM.Class (MonadSTM, liftSTM)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import Data.Binary (Binary (get, put), Get, Put)
+import Data.Functor.Identity (Identity (Identity, runIdentity))
+import qualified Data.Map as M
+    (Map, empty,
+     elems, fromList, toList,
+     alter, delete, insert, lookup, update,
+     maxViewWithKey, minViewWithKey, splitLookup)
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as S (Set, delete, fromList, insert, null, singleton, toList)
+liftMaybe :: Monad m => Maybe a -> MaybeT m a
+liftMaybe = MaybeT . return
+-- | 'STM' that can fail.
+-- Note that it doesn't revert the transaction on failure.
+type MS = MaybeT STM
+-- | This type specifies that we want a single value.
+newtype Single = Single {sVal :: Integer}
+-- | This type specifies that we want multiple values.
+newtype Multiple = Multiple {mVal :: S.Set Integer}
+-- | Closed class.
+-- It's instances allow us to choose whether we want to get a single value
+-- or multiple ones.
+class Binary u => Multitude u where
+    mToList :: u -> [Integer]
+    mSingleton :: Integer -> u
+    mInsert :: Integer -> u -> Maybe u -- Nothing means failure
+    mDelete :: Integer -> u -> Maybe u -- Nothing means emptyness
+instance Binary Single where
+    get = fmap Single get
+    put = put . sVal
+instance Multitude Single where
+    mToList = return . sVal
+    mSingleton = Single
+    mInsert _ _ = Nothing
+    mDelete n s = guard (n == sVal s) >> return s
+instance Binary Multiple where
+    get = fmap Multiple get
+    put = put . mVal
+instance Multitude Multiple where
+    mToList = S.toList . mVal
+    mSingleton = Multiple . S.singleton
+    mInsert n u = return $ u {mVal = S.insert n $ mVal u}
+    mDelete n u =
+        let s = S.delete n $ mVal u in if S.null s then Nothing else Just (Multiple s)
+-- | Base type for 'TableVar' and 'TableVars'
+-- Type 't' is an abstract type, same as in the 'Table'.
+-- Type 'a' is a type of value, which can be obtained with 'unVar',
+-- also same as in the 'Table'.
+data TableVarU t a u = TableVar {tvVal :: u}
+-- | Reference to a single value in some table.
+type TableVar t a = TableVarU t a Single
+-- | Reference to multiple values in a single table.
+type TableVars t a = TableVarU t a Multiple
+-- | Function that converts a list of single-value references
+-- to a single multiple-value reference.
+-- Normally it should only be used in 'cInsert' statments.
+fromList :: [TableVar t a] -> TableVars t a
+fromList vs = TableVar $ Multiple $ S.fromList $ map (sVal . tvVal) vs
+-- | Function that converts a multiple-value reference
+-- to a list of single-value references.
+-- Should be used with multiple-value references accompanying values in the 'Table'.
+toList :: TableVars t a -> [TableVar t a]
+toList v = map (TableVar . Single) $ S.toList $ mVal $ tvVal v
+data KeyBack r a i u =
+    KeyBack
+    {
+      kbMap :: TVar (M.Map i u),
+      kbKey :: a -> r TableVarU -> i
+    }
+data PreTable t r k a =
+    PreTable
+    {
+      tMap :: TVar (M.Map Integer (TVar (a, r TableVarU))),
+      tKey :: k (KeyBack r a)
+    }
+-- | Class of key specifications, used in the 'sKeys' field of the 'Spec'.
+class KeysC k where
+    forKeys
+        :: Monad m =>
+           k f
+        -> (forall i u. (Multitude u, Ord i) => f i u -> m (g i u))
+        -> m (k g)
+-- | Empty key specification.
+-- It doesn't specify any key whatsoever.
+data Keys (f :: * -> * -> *) = Keys
+instance KeysC Keys where forKeys ~Keys _ = return Keys
+-- | One key specification.
+-- Note that it can't be used in the 'sKeys' field by itself,
+-- but rather should be combined with 'Keys' with the ':+:' operator.
+data KeyRef i u
+-- | Combining operator for key specifications.
+data (ks :+: k) f where (:+:) :: ks f -> f i u -> (ks :+: KeyRef i u) f
+infixl 5 :+:
+-- | Class of the part of key specification, corresponding to one key.
+class KeysComponent k where
+    forKeysComponent
+        :: (KeysC ks, Monad m) =>
+           (ks :+: k) f
+        -> (forall i u. (Multitude u, Ord i) => f i u -> m (g i u))
+        -> m ((ks :+: k) g)
+instance (KeysC ks, KeysComponent k) => KeysC (ks :+: k) where forKeys = forKeysComponent
+instance (Multitude u, Ord i) => KeysComponent (KeyRef i u) where
+    forKeysComponent (ksf :+: fiu) action =
+        liftM2 (:+:) (forKeys ksf action) (action fiu)
+-- | Class of table reference specifications, used in the 'sRefs' field of the 'Spec'.
+class RefsC r where
+    putRefs
+        :: Monad m =>
+           r f
+        -> (forall t a u. Multitude u => f t a u -> m ())
+        -> m ()
+    getRefs
+        :: Monad m =>
+           (forall t a u. Multitude u => m (f t a u))
+        -> m (r f)
+-- | Empty reference specification.
+-- It doesn't specify any reference whatsoever.
+data Refs (f :: * -> * -> * -> *) = Refs
+instance RefsC Refs where
+    putRefs ~Refs _ = return ()
+    getRefs _ = return Refs
+-- | One table reference specification.
+-- Note that it can't be used in the 'sRefs' field by itself,
+-- but rather should be combined with 'Refs' with the ':&:' operator.
+data Ref t a u
+-- | Combining operator for reference specifications.
+data (rs :&: r) f where (:&:) :: rs f -> f t a u -> (rs :&: Ref t a u) f
+infix 5 :&:
+-- | Class of the part of reference specification, corresponding to one reference.
+class RefsComponent r where
+    putRefsComponent
+        :: (RefsC rs, Monad m) =>
+           (rs :&: r) f
+        -> (forall t a u. Multitude u => f t a u -> m ())
+        -> m ()
+    getRefsComponent
+        :: (RefsC rs, Monad m) =>
+           (forall t a u. Multitude u => m (f t a u))
+        -> m ((rs :&: r) f)
+instance (RefsC rs, RefsComponent r) => RefsC (rs :&: r) where
+    putRefs = putRefsComponent
+    getRefs = getRefsComponent
+instance Multitude u => RefsComponent (Ref t a u) where
+    putRefsComponent (rsf :&: ftau) action = putRefs rsf action >> action ftau
+    getRefsComponent action = liftM2 (:&:) (getRefs action) action
+-- | Abstract type, which represents a collection of values of type 'a',
+-- possibly accompanied with some references to other 'Table's.
+-- The type 't' is an abstract type, used to ensure that we don't confuse
+-- different tables with values of the same type.
+-- 'r' is a type of references accompanying each value.
+data Table t r a where
+    Table :: (KeysC k, RefsC r) => PreTable t r k a -> TVar Integer -> Table t r a
+-- | Abstract type, which allows us to 'select' one or many values from the 'Table'.
+-- Type 't' is an abstract type, same as in the 'Table'.
+-- Type 'a' is a type of values, also same as in the 'Table'.
+-- Type 'i' is a type of index values, used by this key.
+-- Type 'u' is either 'Multiple' or 'Single', depending on whether this key
+-- allows different values to have the same index, or not.
+newtype Key t a i u = Key {kVal :: TVar (M.Map i u)}
+-- | Type that is a template for the key. Used only in 'Spec's.
+-- Type 't' is an abstract type, same as in the 'Table'.
+-- Type 'a' is a type of values in that 'Table'.
+-- Type 'i' is a type of index values, used by this key.
+-- Type 'u' is either 'Multiple' or 'Single', depending on whether this key
+-- allows different values to have the same index, or not.
+newtype KeySpec r a i u = KeySpec {ksVal :: a -> r TableVarU -> i}
+-- | This is a more generic version of 'single'.
+-- The difference is that value index will be calculated based on both the value
+-- and it's accompanying references.
+single_ :: (a -> r TableVarU -> i) -> KeySpec r a i Single
+single_ = KeySpec
+-- | This is a more generic version of 'multiple'.
+-- The difference is that value index will be calculated based on both the value
+-- and it's accompanying references.
+multiple_ :: (a -> r TableVarU -> i) -> KeySpec r a i Multiple
+multiple_ = KeySpec
+-- | This key will provide access to a single value within a 'Table'.
+-- It's index will be calculated, based on this value alone.
+single :: (a -> i) -> KeySpec r a i Single
+single f = single_ $ const . f
+-- | This key will provide access to multiple values in the same 'Table'.
+-- Their indices will be calculated based on the value alone.
+multiple :: (a -> i) -> KeySpec r a i Multiple
+multiple f = multiple_ $ const . f
+-- | Type that is a template for references to another table. Used only in 'Spec's.
+-- Type 't' is an abstract type, same as in the 'Table'.
+-- Type 'a' is a type of values in that 'Table'.
+-- Type 'u' is either 'Single' or 'Multiple',
+-- depending on whether the reference, accompanying the value,
+-- should be single-value or multiple-value
+data TableRef t a u = TableRef
+-- | Each value in the table-to-be should be accompanied with a single-value reference.
+only :: Table t r a -> TableRef t a Single
+only = const TableRef
+-- | Each value in the table-to-be should be accompanied with a multiple-value reference.
+some :: Table t r a -> TableRef t a Multiple
+some = const TableRef
+-- | Type of table specifications.
+data Spec r k a =
+    Spec
+    {
+      sRefs :: r TableRef,
+      -- ^ Other tables that should be referenced
+      -- by values of this one.
+      sKeys :: k (KeySpec r a) -- ^ Keys for the table-to-be
+    }
+-- | Output of the 'createTable' function.
+data Created t r k a =
+    Created
+    {
+      cTable :: Table t r a, -- ^ The table itself
+      cKeys :: k (Key t a) -- ^ Keys for the table
+    }
+data KeyProcess r a i u =
+    KeyProcess
+    {
+      kpBack :: KeyBack r a i u,
+      kpMap :: M.Map i u
+    }
+insertMap :: (Multitude u, Ord k) => Integer -> k -> M.Map k u -> Maybe (M.Map k u)
+insertMap n i km =
+    case M.lookup i km of
+      Nothing -> return $ M.insert i (mSingleton n) km
+      Just u -> flip (M.insert i) km `fmap` mInsert n u
+forKeys_
+    :: (KeysC k, Monad m) =>
+       k f
+    -> (forall i u. (Multitude u, Ord i) => f i u -> m ())
+    -> m ()
+forKeys_ ks action = forKeys ks (\k -> action k >> return k) >> return ()
+-- | Function that creates the table (along with keys and everything) based on a 'Spec'.
+-- Instead of returning the table, it uses continuation-based approach to ensure
+-- that there is only one 'Table' with this exact 't' argument,
+-- and that this argument doesn't escape.
+createTable
+    :: (KeysC k, Monad m, MonadSTM m, RefsC r) =>
+       Spec r k a
+    -> (forall t. Created t r k a -> m b)
+    -> m b
+createTable s action = liftSTM created >>= action where
+    created =
+        do counter <- newTVar 0
+           tm <- newTVar M.empty
+           tk <-
+               forKeys (sKeys s) $ \ks ->
+                   do kbm <- newTVar M.empty
+                      return KeyBack {kbMap = kbm, kbKey = ksVal ks}
+           let result =
+                   Created
+                   {
+                     cTable = Table PreTable {tMap = tm, tKey = tk} counter,
+                     cKeys = runIdentity $ forKeys tk $ Identity . Key . kbMap
+                   }
+           return result
+-- | Function that selects one value from a 'Key'.
+-- Note that the value is not returned directly.
+-- Instead, a reference to it is returned, which allows to get other references,
+-- accompanying that value in the 'Table'.
+select :: Ord i => Key t a i Single -> i -> MS (TableVar t a)
+select k i = fmap TableVar $ lift (readTVar $ kVal k) >>= liftMaybe . M.lookup i
+listUnMaybe :: Maybe [a] -> [a]
+listUnMaybe Nothing = []
+listUnMaybe (Just as) = as
+-- | A more generic version of 'select'. Instead of one value, it returns multiple ones.
+-- It can also select values with indices that are smaller or greater to the provided one,
+-- depending on the third argument, which could be anything like @(>)@, @(<=)@, @(/=)@,
+-- or even @return True@.
+select_ ::
+    (Multitude u, Ord i)
+    => Key t a i u
+    -> i
+    -> (forall o. Ord o => o -> o -> Bool)
+    -> STM [TableVar t a]
+select_ k i c =
+    do kv <- readTVar $ kVal k
+       let ~(l, e, g) = M.splitLookup i kv
+           lvs =
+               do ~((li, _), _) <- M.minViewWithKey l
+                  guard $ i `c` li
+                  return $ M.elems l >>= mToList
+           evs =
+               do u <- e
+                  guard $ i `c` i
+                  return $ mToList u
+           gvs =
+               do ~((gi, _), _) <- M.maxViewWithKey l
+                  guard $ i `c` gi
+                  return $ M.elems g >>= mToList
+       return $ map (TableVar . Single) $ [lvs, evs, gvs] >>= listUnMaybe
+-- | Function that lets one to insert a new value to the 'Table'.
+-- Of course, we have to provide accompanying references as well.
+-- This function can fail if some key clashes with an already existing one.
+insert :: Table t r a -> a -> r TableVarU -> MS (TableVar t a)
+insert (Table pt counter) a r =
+    do c <- lift $ readTVar counter
+       kps <-
+           forKeys (tKey pt) $ \kb ->
+               do km <- lift $ readTVar $ kbMap kb
+                  km' <- liftMaybe $ insertMap c (kbKey kb a r) km
+                  return KeyProcess {kpBack = kb, kpMap = km'}
+       lift $ do
+         writeTVar counter $! c + 1
+         forKeys_ kps $ \kp -> writeTVar (kbMap $ kpBack kp) $ kpMap kp
+         pr <- newTVar (a, r)
+         modifyTVar' (tMap pt) $ M.insert c pr
+         return $ TableVar $ Single c
+-- | Function that dereferences a value from table.
+-- Note that we have to provide the 'Table' along with 'TableVar'.
+readVar :: Table t r a -> TableVar t a -> MS a
+readVar (Table pt _) v =
+    do mp <- lift $ readTVar $ tMap pt
+       pr <- liftMaybe $ M.lookup (sVal $ tvVal v) mp
+       ~(a, _) <- lift $ readTVar pr
+       return a
+-- | Function that reads all references accompanying the value.
+readRefs :: Table t r a -> TableVar t a -> MS (r TableVarU)
+readRefs (Table pr _) v =
+    fmap snd $ lift (readTVar $ tMap pr) >>=
+    liftMaybe . M.lookup (sVal $ tvVal v) >>= lift . readTVar
+-- | More generic version of 'update'.
+-- It allows changing accompanying references as well as the value.
+update_ :: Table t r a -> TableVar t a -> a -> r TableVarU -> MS ()
+update_ (Table pt _) v a r =
+    do let n = sVal $ tvVal v
+       pr <- lift (readTVar $ tMap pt) >>= liftMaybe . M.lookup n
+       ~(a', r') <- lift $ readTVar pr
+       kps <-
+           forKeys (tKey pt) $ \kb ->
+               do km <- lift $ readTVar $ kbMap kb
+                  km' <-
+                      liftMaybe $
+                      insertMap n (kbKey kb a r) $
+                      M.update (mDelete n) (kbKey kb a' r') km
+                  return KeyProcess {kpBack = kb, kpMap = km'}
+       lift $ do
+         forKeys_ kps $ \kp -> writeTVar (kbMap $ kpBack kp) $ kpMap kp
+         writeTVar pr (a, r)
+-- | Function that writes another value to the referenced place in the 'Table'.
+-- It doesn't change the accompanying references.
+-- In case that it fails due to some single-value key prohibiting the new value,
+-- nothing is changed, and the 'Table' remains the same.
+update :: Table t r a -> TableVar t a -> a -> MS ()
+update t v a = readRefs t v >>= update_ t v a
+-- | Function that removes the value (along with accompanying references)
+-- from the 'Table'. It only fails if the value was already removed.
+delete :: Table t r a -> TableVar t a -> MS ()
+delete (Table pt _) v =
+    do let n = sVal $ tvVal v
+       tm <- lift $ readTVar $ tMap pt
+       pr <- liftMaybe $ M.lookup n tm
+       lift $ do
+         ~(a, r) <- readTVar pr
+         forKeys_ (tKey pt) $ \kb ->
+             modifyTVar' (kbMap kb) $ M.update (mDelete n) (kbKey kb a r)
+         writeTVar (tMap pt) $! M.delete n tm
+-- | The most generic version of 'getTable'.
+-- Not only it allows to change the way values are serialized,
+-- it also permits side-effects during the deserialization.
+-- The table is still filled in one 'STM' transaction,
+-- thus avoiding any difficulties with multithreading.
+getTable__ :: (Monad m, MonadSTM m) => Get (m a) -> Table t r a -> Get (m ())
+getTable__ g (Table pt c) =
+    do l <- get
+       listM <-
+           replicateM l $ do
+             i <- get :: Get Integer
+             ma <- g
+             r <- getRefs $ liftM TableVar get
+             return (i, ma, r)
+       n <- get
+       return $ do
+         list <- forM listM $ \ ~(i, ma, r) -> liftM (\a -> (i, a, r)) ma
+         let result =
+                 do forKeys_ (tKey pt) $ \kb -> writeTVar (kbMap kb) M.empty
+                    tm <-
+                        forM list $ \ ~(i, a, r) ->
+                            do pr <- newTVar (a, r)
+                               forKeys_ (tKey pt) $ \kb ->
+                                   modifyTVar' (kbMap kb) $
+                                   flip M.alter (kbKey kb a r) $ Just . \mu ->
+                                       case mu of
+                                         Nothing -> mSingleton i
+                                         Just u -> fromMaybe u $ mInsert i u
+                               return (i, pr)
+                    writeTVar (tMap pt) $ M.fromList tm
+                    writeTVar c n
+         liftSTM result
+-- | More generic version of 'getTable'
+-- that allows to change the way values are serialized.
+getTable_ :: Get a -> Table t r a -> Get (STM ())
+getTable_ g = getTable__ $ fmap return g
+-- | Function that makes it possible to read the table from the file or other source.
+-- Table should be created beforehand, as specifications are not serializable.
+getTable :: Binary a => Table t r a -> Get (STM ())
+getTable = getTable_ get
+-- | The most generic version of 'putTable'.
+-- Not only it allows to change the way values are serialized,
+-- it also permits side-effects during the serialization.
+-- The table is still read in one 'STM' transaction,
+-- thus avoiding any difficulties with multithreading.
+putTable__ :: (Monad m, MonadSTM m) => (a -> m Put) -> Table t r a -> m Put
+putTable__ p (Table pt c) =
+    do ~(listM, n) <-
+           liftSTM $ do
+             tm <- readTVar $ tMap pt
+             list <-
+                 forM (M.toList tm) $ \ ~(i, v) ->
+                 do ~(a, r) <- readTVar v
+                    return (i, a, r)
+             n <- readTVar c
+             return (list, n)
+       list <- forM listM $ \ ~(i, a, r) -> liftM (\pa -> (i, pa, r)) $ p a
+       return $ do
+         put $ length list
+         forM_ list $ \ ~(i, pa, r) ->
+             do put i
+                pa
+                putRefs r $ \v -> put (tvVal v)
+         put n
+-- | More generic version of 'putTable'
+-- that allows to change the way values are serialized.
+putTable_ :: (a -> Put) -> Table t r a -> STM Put
+putTable_ p = putTable__ $ return . p
+-- | Function that makes it possible to write the table to the file or other storage.
+putTable :: Binary a => Table t r a -> STM Put
+putTable = putTable_ put

@@ -1,51 +0,0 @@-{-# LANGUAGE GADTs, TypeOperators #-}
-module Data.HMemDb.Bin
-    (
-     Bin(Bin, binGet, binPut),
-     Proxy(Proxy, unProxy),
-     TableGetData(TableGetData),
-     TableRefs(TRNil, TRPair, TRProxy, TRVar),
-     binUnit, binProxy, binCRef, binPair
-    ) where
-import Control.Applicative (liftA2, (<$>))
-import Control.Compose ((:.))
-import Control.Concurrent.STM (TVar)
-import Data.Binary (Binary(get, put), Get, Put)
-import Data.Map (Map)
-import Data.HMemDb.MapTVar (MS)
-import Data.HMemDb.References (CRef, cRefIndex, readCRef)
-import Data.HMemDb.Utils (oBind, pureO)
-data Proxy a = Proxy {unProxy :: a} -- should be newtype, but GHC gives annoying warnings.
-data TableGetData a where
-    TableGetData :: (r -> MS a) -> TVar (Map Integer (TVar (Maybe r))) -> TableGetData a
-data TableRefs r where
-    TRNil :: TableRefs ()
-    TRProxy :: TableRefs (Proxy r)
-    TRVar :: TableGetData a -> TableRefs (CRef a)
-    TRPair :: TableRefs r1 -> TableRefs r2 -> TableRefs (r1, r2)
-data Bin r =
-    Bin
-    {
-      binPut :: r -> Put,
-      binGet :: TableRefs r -> (Get :. MS) r
-    }
-binUnit :: Bin ()
-binUnit = Bin {binPut = put, binGet = \TRNil -> pureO $ return ()}
-binProxy :: Binary r => Bin (Proxy r)
-binProxy = Bin {binPut = put . unProxy, binGet = \TRProxy -> pureO $ Proxy <$> get}
-tableVarBinGet :: TableRefs (CRef a) -> Integer -> MS (CRef a)
-tableVarBinGet (TRVar (TableGetData to cnt)) n = readCRef to cnt n
-binCRef :: Bin (CRef a)
-binCRef =
-    Bin
-    {
-      binPut = put . cRefIndex,
-      binGet = \tref -> pureO get `oBind` tableVarBinGet tref
-    }
-binPair :: Bin r1 -> Bin r2 -> Bin (r1, r2)
-binPair b1 b2 =
-    Bin
-    {
-      binPut = \ ~(r1, r2) -> binPut b1 r1 >> binPut b2 r2,
-      binGet = \(TRPair tr1 tr2) -> liftA2 (,) (binGet b1 tr1) (binGet b2 tr2)
-    }

@@ -1,8 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Data.HMemDb.Binary (GS, SP) where
-import Control.Compose ((:.))
-import Control.Concurrent.STM (STM)
-import Data.Binary.Get (Get)
-import Data.Binary.Put (PutM)
-type GS = Get :. STM
-type SP = (STM :. PutM) ()

@@ -1,61 +0,0 @@-{-# LANGUAGE GADTs, TypeOperators #-}
-module Data.HMemDb.CreateTable
-    (CreateTable(makeTable, fixKeys), IsKeySpec, createTable) where
-import Control.Concurrent.STM (STM, newTVar)
-import qualified Data.Map as M (empty)
-import Data.HMemDb.Bin (Bin, TableRefs)
-import Data.HMemDb.ForeignKeys
-    (ForeignKey, PreForeignKey(PreForeignKey), makeForeignKey)
-import Data.HMemDb.KeyBackends (KeyBack(KeyBack), PreKeyBack(PreKeyBack))
-import Data.HMemDb.MapTVar (readTVarMap)
-import Data.HMemDb.RefContainer (RefContainer)
-import Data.HMemDb.RefConverter (PreRefConv, RefConv(RefConv))
-import Data.HMemDb.Specs
-    (FullSpec(keySpec, tabSpec), Keys(Keys), KeySpec(KeySpec), makeRC, (:+:)((:+:)))
-import Data.HMemDb.Tables
-    (PreTable(tabIndices), Table(Table), emptyPreTable)
--- | This is a class of sets of 'Data.HMemDb.KeySpec's and 'Data.HMemDb.ForeignKey's
-class CreateTable u where
-    makeTable ::
-        Bin r
-        -> TableRefs r
-        -> PreRefConv r a a
-        -> u a KeySpec 
-        -> STM (PreTable r a, u a (PreForeignKey r))
-    fixKeys ::
-        Bin r -> PreTable r a -> u a (PreForeignKey r) -> u a ForeignKey
-instance CreateTable Keys where
-    makeTable _ tr pr ~Keys =
-        do pt <- emptyPreTable tr pr
-           return (pt, Keys)
-    fixKeys _ _ ~Keys = Keys
--- | This class is here for technical reasons; it has just one instance.
-class IsKeySpec ks where
-    makeTableKS ::
-        CreateTable u => Bin r
-        -> TableRefs r
-        -> PreRefConv r a a
-        -> (u :+: ks) a KeySpec
-        -> STM (PreTable r a, (u :+: ks) a (PreForeignKey r))
-instance (Ord i, RefContainer s) => IsKeySpec (KeySpec s i) where
-    makeTableKS b tr pr (uk :+: KeySpec h) =
-        do ~(pt, uf) <- makeTable b tr pr uk
-           ii <- newTVar M.empty
-           tv <- newTVar M.empty
-           let pt' = pt {tabIndices = KeyBack (PreKeyBack h ii tv) : tabIndices pt}
-           return (pt', uf :+: PreForeignKey (readTVarMap tv))
-instance (CreateTable u, IsKeySpec ks) => CreateTable (u :+: ks) where
-    makeTable = makeTableKS
-    fixKeys b pt (uf :+: pfk) = fixKeys b pt uf :+: makeForeignKey b pt pfk
-createTable :: CreateTable u => FullSpec a u -> STM (Table a, u a ForeignKey)
--- ^ This function creates an empty table,
--- given the table structure ('Data.HMemDb.TableSpec')
--- and the set of keys ('Data.HMemDb.KeySpec').
--- It returns the table itself, accompanied with the same set of foreign keys,
--- allowing one to search through the table quickly,
--- or to make a new 'Data.HMemDb.TableSpec'.
-createTable fs =
-    case makeRC $ tabSpec fs of
-      RefConv b tr pr ->
-          do (pt, pfks) <- makeTable b tr pr (keySpec fs)
-             return (Table b pt, fixKeys b pt pfks)

@@ -1,49 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Data.HMemDb.ForeignKeys
-    (ForeignKey(ForeignKey), PreForeignKey(PreForeignKey),
-     delete, getCRef, keyTarget, makeForeignKey, select, update) where
-import Control.Compose (Id, unId)
-import Control.Concurrent.STM (STM)
-import Control.Monad (void)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Maybe (runMaybeT)
-import Data.Foldable (Foldable)
-import Data.HMemDb.Bin (Bin)
-import Data.HMemDb.MapTVar (MS)
-import Data.HMemDb.RefConverter (rcTo)
-import Data.HMemDb.References (CRef(CRef), Ref)
-import Data.HMemDb.Tables (PreTable, Table(Table), tabConv)
-import Data.HMemDb.TableVars (TableVarS(TableVar), deleteTV, forTV, modifyTV)
--- | This is a type of foreign keys. Each foreign key points to one table.
--- It is used to find the values in this table using 'select'.
--- Foreign keys are created at the same time 'Table's are.
--- They can't be added afterwards.
-newtype PreForeignKey r s i a = PreForeignKey {runPreForeignKey :: i -> MS (s (Ref r))}
-data ForeignKey s i a where
-    ForeignKey :: Bin r -> PreTable r a -> (i -> MS (s (Ref r))) -> ForeignKey s i a
-makeForeignKey :: Bin r -> PreTable r a -> PreForeignKey r s i a -> ForeignKey s i a
-makeForeignKey b pt pfk = ForeignKey b pt $ runPreForeignKey pfk
-select :: Ord i => ForeignKey s i a -> i -> MS (TableVarS s a)
--- ^ This function searches for some particular index in the table.
--- It fails if there is no value with that index. Empty set of values is never returned.
--- For non-unique indices it returns the set of 'Data.HMemDb.TableVar's.
-select (ForeignKey b pt lkp) i =
-    do s <- lkp i
-       return $ TableVar b s pt
-getCRef :: Ord i => ForeignKey Id i a -> i -> MS (CRef a)
-getCRef (ForeignKey _ pt lkp) i =
-    do iref <- lkp i
-       return $ CRef (unId iref) $ rcTo (tabConv pt)
-delete :: (Foldable s, Ord i) => ForeignKey s i a -> i -> STM ()
--- ^ This function deletes the value from the table. It won't be accessible anymore.
--- It never fails; nonexistent values are silently skipped.
-delete f i = void $ runMaybeT $ select f i >>= lift . forTV (runMaybeT . deleteTV)
-update :: Ord i => ForeignKey Id i a -> i -> a -> MS a
--- ^ This function overrides the existing value in the table with the new one.
--- All foreign keys pointing to the original value become pointing to the new value.
--- It returns the original value, which is no longer in the table.
--- Failure means that there was no such value.
-update f i new = select f i >>= modifyTV new
-keyTarget :: ForeignKey s i a -> Table a
--- ^ This function returns the table that the key points to.
-keyTarget (ForeignKey b pt _) = Table b pt

@@ -1,80 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Data.HMemDb.KeyBackends
-    (
-     PreKeyBack(PreKeyBack),
-     KeyBack(KeyBack),
-     deleteFromKeys,
-     insertIntoKeys,
-     modifyInKeys
-    ) where
-import Control.Concurrent.STM (STM, TVar, modifyTVar', readTVar, writeTVar)
-import Control.Monad (guard, void)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Cont (ContT(ContT, runContT))
-import Control.Monad.Trans.Maybe (runMaybeT)
-import Data.Foldable (for_)
-import Data.Map (Map)
-import qualified Data.Map as M (delete, insert, lookup, update)
-import Data.HMemDb.MapTVar (MS, liftMaybe)
-import Data.HMemDb.RefContainer (RefContainer(insRef, delRef))
-import Data.HMemDb.References (Ref(refIndex))
-brackets :: Monad m => m a -> (a -> m r) -> ContT r m ()
-brackets before after =
-    do a <- lift before
-       ContT $ \f -> f () >> after a
-data PreKeyBack s r a where
-    PreKeyBack ::
-        Ord i => (a -> i)
-        -> TVar (Map Integer i)
-        -> TVar (Map i (s (Ref r)))
-        -> PreKeyBack s r a
-data KeyBack r a where KeyBack :: RefContainer s => PreKeyBack s r a -> KeyBack r a
-insertIntoKey :: RefContainer s => a -> Ref r -> PreKeyBack s r a -> ContT () MS ()
-insertIntoKey new ref (PreKeyBack g ii tv) =
-    brackets before after where
-        before =
-            do let i = g new
-               mp <- lift $ readTVar tv
-               s <- liftMaybe $ insRef ref $ M.lookup i mp
-               return (M.insert (refIndex ref) i, M.insert i s mp)
-        after ~(makeNewImp, newMp) =
-            lift $ do
-              modifyTVar' ii makeNewImp
-              writeTVar tv $! newMp
-insertIntoKeys :: a -> Ref r -> [KeyBack r a] -> MS ()
-insertIntoKeys a ref ks =
-    runContT (for_ ks $ \(KeyBack pk) -> insertIntoKey a ref pk) return
-deleteFromKey :: RefContainer s => Ref r -> PreKeyBack s r a -> STM ()
-deleteFromKey ref (PreKeyBack _ ii tv) =
-    void $ runMaybeT $
-    do imp <- lift $ readTVar ii
-       i <- liftMaybe $ M.lookup (refIndex ref) imp
-       mp <- lift $ readTVar tv
-       s <- liftMaybe $ M.lookup i mp
-       lift $ do
-         writeTVar ii $! M.delete (refIndex ref) imp
-         writeTVar tv $! M.update (const $ delRef ref s) i mp
-deleteFromKeys :: Ref r -> [KeyBack r a] -> STM ()
-deleteFromKeys ref ks = for_ ks $ \(KeyBack pk) -> deleteFromKey ref pk
-modifyInKey :: RefContainer s => a -> Ref r -> PreKeyBack s r a -> ContT () STM ()
-modifyInKey new ref (PreKeyBack g ii tv) =
-    brackets before after where
-        before =
-            runMaybeT $ do
-              let i = refIndex ref
-              imp <- lift $ readTVar ii
-              oldI <- liftMaybe $ M.lookup i imp
-              mp <- lift $ readTVar tv
-              let newI = g new
-              guard $ newI /= oldI
-              oldS <- liftMaybe $ M.lookup oldI mp
-              let tempMp = M.update (const $ delRef ref oldS) oldI mp
-              newS <- liftMaybe $ insRef ref $ M.lookup newI tempMp
-              return (M.insert i newI imp, M.insert newI newS tempMp)
-        after Nothing = return ()
-        after (Just ~(newImp, newMp)) =
-            do writeTVar ii $! newImp
-               writeTVar tv $! newMp
-modifyInKeys :: a -> Ref r -> [KeyBack r a] -> STM ()
-modifyInKeys a ref ks =
-    runContT (for_ ks $ \(KeyBack pk) -> modifyInKey a ref pk) return

@@ -1,13 +0,0 @@-module Data.HMemDb.MapTVar (MS, liftMaybe, readTVarMap) where
-import Control.Concurrent.STM (STM, TVar, readTVar)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Maybe (MaybeT(MaybeT))
-import Data.Map (Map)
-import qualified Data.Map as M (lookup)
-type MS = MaybeT STM
-liftMaybe :: Monad m => Maybe a -> MaybeT m a
-liftMaybe = MaybeT . return
-readTVarMap :: Ord k => TVar (Map k a) -> k -> MS a
-readTVarMap tv k =
-    do mp <- lift $ readTVar tv
-       liftMaybe $ M.lookup k mp

@@ -1,46 +0,0 @@-module Data.HMemDb.Persistence (fillTable, putTable) where
-import Control.Applicative (Applicative(pure, (<*>)), (<$>))
-import Control.Concurrent.STM (STM, TVar, readTVar, writeTVar)
-import Control.Monad.Trans.Cont (Cont, runCont, cont)
-import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
-import Data.Binary (Binary(get, put))
-import Data.Foldable (for_)
-import qualified Data.Map as M (toAscList)
-import Data.HMemDb.Bin (Bin (binGet, binPut))
-import Data.HMemDb.Binary (GS, SP)
-import Data.HMemDb.Tables
-    (PreTable(tabContent, tabCount, tabRefs), Table(Table), insertRefIntoTable)
-import Data.HMemDb.Utils
-    (bindO, enumElem, fixArray, oBind, liftPure, pureO, replicateO)
--- serialization
-putTVar :: TVar a -> Cont SP a
-putTVar tv = cont $ bindO $ readTVar tv
-readValue :: (a, TVar (Maybe b)) -> STM (Maybe (a, b))
-readValue (n, tv) = fmap ((,) n) <$> readTVar tv
-putPreTable :: Bin r -> PreTable r a -> Cont SP ()
-putPreTable b pt =
-    do tC <- putTVar $ tabCount pt
-       liftPure $ put tC
-       mp <- putTVar $ tabContent pt
-       pairs <- fixArray (M.toAscList mp) readValue
-       liftPure $ put $ length pairs
-       ~(n, r) <- enumElem pairs
-       liftPure $ put n >> binPut b r
-putTable :: Table a -> SP
--- ^ This function saves the table to the ByteString.
--- Note that it doesn't really matter if the type of values in the table
--- are serializable.
---
--- NB: if any index used to access the values in this table depended on any foreign keys,
--- and targets of these keys have changed,
--- the index could be different after storing and restoring the table.
-putTable (Table b pt) = runCont (putPreTable b pt) pure
--- deserialization
-fillTable :: Table a -> GS ()
--- ^ This function reads the table from the ByteString.
-fillTable (Table b pt) = genPairs `oBind` insPairs where
-    genPair = (,) <$> pureO get <*> binGet b (tabRefs pt)
-    genPairs = (,) <$> pureO get <*> (get `bindO` replicateO genPair)
-    insPairs ~(counter, pairs) =
-        do writeTVar (tabCount pt) counter
-           for_ pairs $ runMaybeT . insertRefIntoTable pt

@@ -1,20 +0,0 @@-module Data.HMemDb.RefContainer (RefContainer(insRef, delRef)) where
-import Control.Compose (Id(Id))
-import Data.Foldable (Foldable)
-import Data.Set (Set, delete, empty, insert, singleton)
-import Data.HMemDb.References (Ref)
--- | This class is a closed one; the user is not supposed to create new instances.
--- It allows treating unique and non-unique keys in the same way.
-class Foldable s => RefContainer s where
-    insRef :: Ref r -> Maybe (s (Ref r)) -> Maybe (s (Ref r))
-    delRef :: Ref r -> s (Ref r) -> Maybe (s (Ref r))
-instance RefContainer Id where
-    insRef ref Nothing = Just $ Id ref
-    insRef _ (Just _) = Nothing
-    delRef _ _ = Nothing
-instance RefContainer Set where
-    insRef ref Nothing = Just $ singleton ref
-    insRef ref (Just s) = Just $ insert ref s
-    delRef ref s =
-        let s' = delete ref s
-        in if s' == empty then Nothing else Just s'

@@ -1,25 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Data.HMemDb.RefConverter
-    (PreRefConv(PreRefConv, rcFrom, rcTo), RefConv(RefConv)) where
-import Control.Applicative (Applicative(pure, (<*>)))
-import Control.Monad (liftM2)
-import Data.HMemDb.Bin (Bin, TableRefs(TRNil, TRPair), binPair, binUnit)
-import Data.HMemDb.MapTVar (MS)
-data PreRefConv r input output =
-    PreRefConv {rcFrom :: input -> MS r, rcTo :: r -> MS output}
-data RefConv input output where
-    RefConv :: Bin r -> TableRefs r -> PreRefConv r input output -> RefConv input output
-(|*|) ::
-    PreRefConv r1 input (middle -> output)
-    -> PreRefConv r2 input middle
-    -> PreRefConv (r1, r2) input output
-p1 |*| p2 = PreRefConv from to where
-   from input = liftM2 (,) (rcFrom p1 input) (rcFrom p2 input)
-   to (r1, r2) = liftM2 ($) (rcTo p1 r1) (rcTo p2 r2)
-instance Functor (RefConv input) where fmap h r = pure h <*> r
-instance Applicative (RefConv input) where
-    pure output =
-        RefConv binUnit TRNil $
-        PreRefConv {rcFrom = const $ return (), rcTo = \ ~() -> return output}
-    RefConv bf trf pf <*> RefConv bx trx px =
-        RefConv (binPair bf bx) (TRPair trf trx) (pf |*| px)

@@ -1,25 +0,0 @@-{-# LANGUAGE GADTs#-}
-module Data.HMemDb.References
-    (CRef(CRef), Ref(Ref, refContent, refIndex),
-     cRefIndex, deCRef, deRef, readCRef) where
-import Control.Concurrent.STM (TVar, readTVar)
-import Control.Monad.Trans.Maybe (MaybeT(MaybeT))
-import Data.Function (on)
-import Data.Map (Map)
-import Data.HMemDb.MapTVar (MS, readTVarMap)
-data Ref r = Ref {refContent :: TVar (Maybe r), refIndex :: Integer}
-instance Eq (Ref r) where (==) = (==) `on` refIndex
-instance Ord (Ref r) where compare = compare `on` refIndex
-deRef :: Ref r -> MS r
-deRef ref = MaybeT $ readTVar $ refContent ref
-data CRef a where CRef :: Ref r -> (r -> MS a) -> CRef a
-cRefIndex :: CRef a -> Integer
-cRefIndex (CRef ref _) = refIndex ref
-instance Eq (CRef a) where (==) = (==) `on` cRefIndex
-instance Ord (CRef a) where compare = compare `on` cRefIndex
-deCRef :: CRef a -> MS a
-deCRef (CRef ref to) = deRef ref >>= to
-readCRef :: (r -> MS a) -> TVar (Map Integer (TVar (Maybe r))) -> Integer -> MS (CRef a)
-readCRef to tv i =
-    do v <- readTVarMap tv i
-       return $ CRef (Ref {refContent = v, refIndex = i}) to

@@ -1,117 +0,0 @@-{-# LANGUAGE KindSignatures, GADTs, TypeOperators #-}
-module Data.HMemDb.Specs
-    (
-     ColSpec,
-     FullSpec(FullSpec, keySpec, tabSpec),
-     Keys(Keys),
-     KeySpec(KeySpec),
-     TableSpec,
-     key,
-     makeRC,
-     mval,
-     nonunique,
-     tref,
-     val,
-     unique,
-     (:+:)((:+:))) where
-import Control.Applicative (Applicative(pure, (<*>)), (<$>))
-import Control.Compose (Id)
-import Data.Binary (Binary)
-import Data.Set (Set)
-import Data.HMemDb.Bin
-    (Proxy(Proxy, unProxy), TableGetData(TableGetData), TableRefs(TRProxy, TRVar),
-     binProxy, binCRef)
-import Data.HMemDb.ForeignKeys (ForeignKey, getCRef, keyTarget)
-import Data.HMemDb.MapTVar (liftMaybe)
-import Data.HMemDb.RefConverter (PreRefConv(PreRefConv, rcFrom, rcTo), RefConv(RefConv))
-import Data.HMemDb.References (cRefIndex, deCRef, readCRef)
-import Data.HMemDb.Tables (Table(Table), tabContent, tabConv)
-import Data.HMemDb.TableVarId (TableVarId(TableVarId))
-data TableSpecPart input col where
-    TSPVal ::
-        Binary r => (input -> r)
-        -> (r -> Maybe col)
-        -> TableSpecPart input col
-    TSPKey :: Ord i => (input -> i) -> ForeignKey Id i col -> TableSpecPart input col
-    TSPRef ::
-        (input -> TableVarId col) -> Table col -> TableSpecPart input (TableVarId col)
--- | This is the internal of the 'TableSpec' type.
-data ColSpec input output where
-    CSEnd :: output -> ColSpec input output
-    CSPart ::
-        TableSpecPart input col -> ColSpec input (col -> output) -> ColSpec input output
-instance Functor (ColSpec input) where
-    fmap h (CSEnd output) = CSEnd $ h output
-    fmap h (CSPart csp c) = CSPart csp $ (h .) <$> c
-instance Applicative (ColSpec input) where
-    pure = CSEnd
-    CSEnd h <*> c = h <$> c
-    CSPart csp c <*> c' = CSPart csp $ flip <$> c <*> c'
-val :: Binary col => (input -> col) -> ColSpec input col
--- ^ This function specifies one column in the table.
--- It instructs the library to store one part of the value.
-val = mval id Just
-mval :: Binary r => (col -> r) -> (r -> Maybe col) -> (input -> col) -> ColSpec input col
--- ^ This function specifies one column in the table.
--- It instructs the library to store one part of the value in a specific way.
-mval p g h = CSPart (TSPVal (p . h) g) (pure id)
-key :: Ord i => ForeignKey Id i col -> (input -> i) -> ColSpec input col
--- ^ This function specifies one column in the table. Unlike 'val', it doesn't
--- store some part of the value; instead it stores the reference to some other table.
-key k h = CSPart (TSPKey h k) (pure id)
-tref :: Table col -> (input -> TableVarId col) -> ColSpec input (TableVarId col)
--- ^ This function eases the use of 'TableVarId's as columns of the table.
-tref t h = CSPart (TSPRef h t) (pure id)
-type TableSpec a = ColSpec a a
--- ^ This type represents the table structure. It can be generated using the
--- 'Applicative' interface of the 'ColSpec' like this:
---
--- > data MyData = {myField1 :: Integer, myField2 :: String}
--- > tabSpec = TableSpec (MyData <$> val myField1 <*> val myField2)
---
-cspToRC :: TableSpecPart input col -> RefConv input col
-cspToRC (TSPVal g d) =
-    RefConv binProxy
-            TRProxy
-            (PreRefConv {rcFrom = return . Proxy . g, rcTo = liftMaybe . d . unProxy})
-cspToRC (TSPKey g f) =
-    case keyTarget f of
-      Table _ pt ->
-          let tgd = TableGetData (rcTo $ tabConv pt) (tabContent pt)
-          in RefConv binCRef
-                 (TRVar tgd)
-                 (PreRefConv {rcFrom = getCRef f . g, rcTo = deCRef})
-cspToRC (TSPRef g (Table _ pt)) =
-    let tv = tabContent pt
-        rto = rcTo $ tabConv pt
-        from input = 
-            do let TableVarId index = g input
-               readCRef rto tv index
-        to = return . TableVarId . cRefIndex
-    in RefConv binCRef
-           (TRVar $ TableGetData rto tv)
-           (PreRefConv {rcFrom = from, rcTo = to})
-makeRC :: ColSpec input output -> RefConv input output
-makeRC (CSEnd output) = pure output
-makeRC (CSPart csp c) = makeRC c <*> cspToRC csp
-data KeySpec (s :: * -> *) i a = KeySpec (a -> i)
--- ^ This is the specification of one 'ForeignKey'. It could be unique or non-unique.
-unique :: (a -> i) -> KeySpec Id i a
--- ^ This function specifies a unique key.
-unique = KeySpec
-nonunique :: (a -> i) -> KeySpec Set i a
--- ^ This function specifies a non-unique key.
-nonunique = KeySpec
-data Keys a (h :: (* -> *) -> * -> * -> *) = Keys
--- ^ This type represents an empty set of 'KeySpec's or 'ForeignKey's.
-data (u :+: ks) a h where (:+:) :: u a h -> h s i a -> (u :+: KeySpec s i) a h
--- ^ This type operator adds one more 'KeySpec' to the set,
--- or allows to get a 'ForeignKey' back with pattern-matching. Use it like this:
---
--- > do (table, ... :+: foreignKey)
--- >      <- createTable $ FullSpec {..., keySpec = ... :+: unique myKey}
---
-infixl 4 :+:
-data FullSpec a u = FullSpec {tabSpec :: TableSpec a, keySpec :: u a KeySpec}
--- ^ This is the full specification, of both table and set of keys,
--- which should be fed to 'Data.HMemDb.createTable' and 'Data.HMemDb.getTable' functions.

@@ -1,22 +0,0 @@-module Data.HMemDb.TableVarId (TableVarId(TableVarId), idToVar, varToId) where-import Control.Compose (Id(Id), unId)-import Data.Function (on)-import Data.HMemDb.MapTVar (MS, readTVarMap)-import Data.HMemDb.References (Ref(Ref, refContent, refIndex))-import Data.HMemDb.Tables (Table(Table), tabContent)-import Data.HMemDb.TableVars (TableVar, TableVarS(TableVar))-newtype TableVarId a = TableVarId {unTVId :: Integer}--- ^ This type can be used for columns in a table.--- It's sort of a 'ForeignKey' accompanied with a specific index.-instance Eq (TableVarId a) where (==) = (==) `on` unTVId--- ^ 'TableVarId's pointing to different 'Table's may accidentally appear equal.-instance Ord (TableVarId a) where compare = compare `on` unTVId-varToId :: TableVar a -> TableVarId a--- ^ This function gets an Id of the variable.-varToId (TableVar _ iref _) = TableVarId $ refIndex $ unId iref-idToVar :: Table a -> TableVarId a -> MS (TableVar a)--- ^ This function looks up the specific Id in the 'Table'.-idToVar (Table b pt) tvId =-    do let i = unTVId tvId-       tv <- readTVarMap (tabContent pt) i-       return $ TableVar b (Id Ref {refContent = tv, refIndex = i}) pt

@@ -1,62 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Data.HMemDb.TableVars 
-    (TableVar, TableVarS(TableVar),
-     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget) where
-import Control.Applicative (Applicative)
-import Control.Concurrent.STM (STM, readTVar)
-import Control.Compose (Id(Id), unId)
-import Control.Monad (mplus, mzero)
-import Data.Foldable (Foldable, for_)
-import Data.Map (toAscList)
-import Data.Set (Set, fromAscList)
-import Data.HMemDb.Bin(Bin)
-import Data.HMemDb.MapTVar (MS)
-import Data.HMemDb.RefConverter (rcTo)
-import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
-import Data.HMemDb.Tables
-    (PreTable(tabContent, tabConv), Table(Table),
-     deleteFromTable, insertIntoTable, modifyInTable)
--- | This is a more generic type, which represents a set of values in the same table.
-data TableVarS s a where
-    TableVar :: Bin r -> s (Ref r) -> PreTable r a -> TableVarS s a
-type TableVar = TableVarS Id
--- ^ This type represents references to individual values in the table.
--- It is returned by 'insert' and 'Data.HMemDb.select' functions.
-tableVarTarget :: TableVarS s a -> Table a
--- ^ This function returns the 'Table' that the 'TableVar' is from.
-tableVarTarget (TableVar b _ pt) = Table b pt
-readTV :: TableVar a -> MS a
--- ^ This function reads the value from the table.
--- It fails if the value was removed before or became invalid.
-readTV (TableVar _ iref pt) =
-    do let ref = unId iref
-       r <- deRef ref
-       rcTo (tabConv pt) r `mplus` (deleteFromTable ref pt >> mzero)
-deleteTV :: TableVar a -> MS a
--- ^ This function removes the value from whatever table it's in.
--- It returnes the original value, provided that it wasn't removed before
--- or invalidated by removing some other value this one references
--- with 'Data.HMemDb.ForeignKey'.
-deleteTV (TableVar _ iref pt) = deleteFromTable (unId iref) pt
-modifyTV :: a -> TableVar a -> MS a
--- ^ This function overrides the value with another one.
--- All indices referencing the original value would be referencing the new one.
--- It fails if the original value was removed before or became invalid.
-modifyTV new (TableVar _ iref pt) = modifyInTable new (unId iref) pt
-insert :: a -> Table a -> MS (TableVar a)
--- ^ This function inserts a new value into the table and gives a 'TableVar' back.
--- Failure indicates that one of the unique indices for this value
--- coincides with the same index of another value already present in the table.
--- It won't happen for non-unique indices.
-insert a (Table b pt) =
-    do ref <- insertIntoTable a pt
-       return $ TableVar b (Id ref) pt
-forTV :: (Foldable s, Applicative f) => (TableVar a -> f b) -> TableVarS s a -> f ()
--- ^ This function iterates through all elements of the set.
-forTV h (TableVar b s pt) = for_ s $ \ref -> h $ TableVar b (Id ref) pt
-selectAll :: Table a -> STM (TableVarS Set a)
--- ^ This function gives the set of all values in the table.
-selectAll (Table b pt) =
-    do mp <- readTVar $ tabContent pt
-       let makeRef ~(n, tv) = Ref {refContent = tv, refIndex = n}
-       return $ TableVar b (fromAscList $ map makeRef $ toAscList mp) pt

@@ -1,92 +0,0 @@-{-# LANGUAGE GADTs #-}
-module Data.HMemDb.Tables
-    (
-     PreTable(tabCount, tabContent, tabConv, tabIndices, tabRefs),
-     Table(Table),
-     deleteFromTable,
-     emptyPreTable,
-     foldTable_,
-     insertIntoTable,
-     insertRefIntoTable,
-     modifyInTable
-    ) where
-import Control.Concurrent.STM (STM, TVar, modifyTVar', newTVar, readTVar, writeTVar)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
-import Data.Foldable (for_)
-import qualified Data.Map as M (Map, delete, empty, insert)
-import Data.HMemDb.Bin (Bin, TableRefs)
-import Data.HMemDb.MapTVar (MS, liftMaybe)
-import Data.HMemDb.KeyBackends (KeyBack, deleteFromKeys, insertIntoKeys, modifyInKeys)
-import Data.HMemDb.RefConverter (PreRefConv(rcFrom, rcTo))
-import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
-data PreTable r a =
-    PreTable
-    {
-      tabCount :: TVar Integer,
-      tabConv :: PreRefConv r a a,
-      tabContent :: TVar (M.Map Integer (TVar (Maybe r))),
-      tabIndices :: [KeyBack r a],
-      tabRefs :: TableRefs r
-    }
-emptyPreTable :: TableRefs r -> PreRefConv r a a -> STM (PreTable r a)
-emptyPreTable tr pr =
-    do count <- newTVar 0
-       content <- newTVar M.empty
-       let pt =
-               PreTable {
-                 tabCount = count,
-                 tabConv = pr,
-                 tabContent = content,
-                 tabIndices = [],
-                 tabRefs = tr
-               }
-       return pt
-data Table a where Table :: Bin r -> PreTable r a -> Table a
--- ^ This type represent tables. Each table is the set of values.
--- Individual values can be accessed with 'Data.HMemDb.TableVar's
--- or 'Data.HMemDb.ForeignKey's.
--- Tables are never created manually,
--- they should be generated by 'Data.HMemDb.createTable'
--- or loaded by 'Data.HMemDb.getTable'.
--- Both functions require the structure of the table to be described
--- as the 'Data.HMemDb.FullSpec'.
-insertTVarIntoTable :: a -> Integer -> TVar (Maybe r) -> PreTable r a -> MS (Ref r)
-insertTVarIntoTable a n tv pt =
-    do let ref = Ref {refContent = tv, refIndex = n}
-       insertIntoKeys a ref $ tabIndices pt
-       lift $ modifyTVar' (tabContent pt) $ M.insert n tv
-       return ref
-insertIntoTable :: a -> PreTable r a -> MS (Ref r)
-insertIntoTable a pt =
-    do n <- lift $ readTVar $ tabCount pt
-       content <- rcFrom (tabConv pt) a >>= lift . newTVar . Just
-       ref <- insertTVarIntoTable a n content pt
-       lift $ writeTVar (tabCount pt) $ n+1
-       return ref
-insertRefIntoTable :: PreTable r a -> (Integer, r) -> MS (Ref r)
-insertRefIntoTable pt ~(n, r) =
-    do tv <- lift $ newTVar $ Just r
-       a <- rcTo (tabConv pt) r
-       insertTVarIntoTable a n tv pt
-deleteFromTable :: Ref r -> PreTable r a -> MS a
-deleteFromTable ref pt =
-    do a <- lift $ runMaybeT $ deRef ref >>= rcTo (tabConv pt)
-       lift $ do
-         modifyTVar' (tabContent pt) $ M.delete $ refIndex ref
-         deleteFromKeys ref $ tabIndices pt
-         writeTVar (refContent ref) Nothing
-       liftMaybe a
-modifyInTable :: a -> Ref r -> PreTable r a -> MS a
-modifyInTable new ref pt = 
-    do old <- deRef ref >>= rcTo (tabConv pt)
-       r <- rcFrom (tabConv pt) new
-       lift $ modifyInKeys new ref $ tabIndices pt
-       lift $ writeTVar (refContent ref) $ Just r
-       return old
-foldTable_ :: (a -> MS b) -> Table a -> STM ()
--- ^ This function traverses through all values in the table, applying the same action
--- to all of them. Errors are silently ignored.
-foldTable_ h (Table _ pt) =
-    do mp <- readTVar $ tabContent pt
-       for_ mp $ \tv -> runMaybeT $ MaybeT (readTVar tv) >>= rcTo (tabConv pt) >>= h

@@ -1,32 +0,0 @@-{-# LANGUAGE TypeOperators #-}
-module Data.HMemDb.Utils
-    (
-     bindO,
-     enumElem,
-     fixArray,
-     liftPure,
-     oBind,
-     pureO,
-     replicateO
-    ) where
-import Control.Applicative (Applicative(pure), (<$>), (<*>))
-import Control.Compose (oFmap, oPure, unO, (:.)(O))
-import Control.Monad.Trans.Cont (Cont, cont)
-import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
-import Data.Foldable (Foldable, for_)
-import Data.Maybe (catMaybes)
-import Data.Traversable (sequenceA)
-liftPure :: (Applicative f, Applicative g) => f a -> Cont ((g :. f) b) ()
-liftPure fa = cont $ \f -> const id <$> oPure fa <*> f ()
-enumElem :: (Applicative f, Foldable t) => t a -> Cont (f ()) a
-enumElem as = cont $ for_ as
-pureO :: (Applicative f, Functor g) => g a -> (g :. f) a
-pureO ga = O $ pure <$> ga
-oBind :: (Functor g, Monad f) => (g :. f) a -> (a -> f b) -> (g :. f) b
-oBind gfa afb = O $ (>>= afb) <$> unO gfa
-bindO :: Monad m => m a -> (a -> (m :. f) b) -> (m :. f) b
-bindO ma amfb = O $ ma >>= unO . amfb
-fixArray :: Monad m => [a] -> (a -> m (Maybe b)) -> Cont ((m :. f) c) [b]
-fixArray xs f = cont $ \h -> mapM f xs `bindO` (h . catMaybes)
-replicateO :: (Applicative f, Applicative g) => (g :. MaybeT f) a -> Int -> (g :. f) [a]
-replicateO gmfa len = catMaybes <$> sequenceA (replicate len $ oFmap runMaybeT gmfa)