hmemdb 0.2.0.0 → 0.2.0.1

raw patch · 17 files changed

+167/−169 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hmemdb.cabal +2/−1
• src/Data/HMemDb.hs +48/−47
• src/Data/HMemDb/Bin.hs +8/−12
• src/Data/HMemDb/Binary.hs +1/−3
• src/Data/HMemDb/CreateTable.hs +10/−17
• src/Data/HMemDb/ForeignKeys.hs +1/−1
• src/Data/HMemDb/KeyBackends.hs +6/−3
• src/Data/HMemDb/MapTVar.hs +13/−0
• src/Data/HMemDb/Persistence.hs +4/−5
• src/Data/HMemDb/RefContainer.hs +1/−1
• src/Data/HMemDb/RefConverter.hs +1/−1
• src/Data/HMemDb/References.hs +10/−5
• src/Data/HMemDb/Specs.hs +34/−25
• src/Data/HMemDb/TableVarId.hs +9/−32
• src/Data/HMemDb/TableVars.hs +1/−1
• src/Data/HMemDb/Tables.hs +16/−4
• src/Data/HMemDb/Utils.hs +2/−11

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hmemdb
-version:             0.2.0.0
+version:             0.2.0.1
 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
@@ -21,6 +21,7 @@                        Data.HMemDb.CreateTable, 
                        Data.HMemDb.ForeignKeys,
                        Data.HMemDb.KeyBackends,
+                       Data.HMemDb.MapTVar,
                        Data.HMemDb.Persistence,
                        Data.HMemDb.RefContainer, 
                        Data.HMemDb.RefConverter, 

@@ -1,47 +1,48 @@-{-# 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, tvIdTarget, tableIds,
--- * Specs
-     FullSpec(FullSpec, keySpec, tabSpec),
--- ** Table specs
-     TableSpec(TableSpec), ColSpec, val, key,
--- ** Key specs
-     KeySpec, unique, nonunique,
--- * Creating tables
-     createTable,
-     Keys(Keys), RefContainer, IsKeySpec, (:+:)((:+:)),
-     CreateTable,
--- * Basic operations
-     insert, select, delete, update,
--- * Serialization
-     getTable, putTable,
-    )
-where
-import Data.HMemDb.Binary (GS, MS, SP)
-import Data.HMemDb.CreateTable (CreateTable, IsKeySpec, createTable)
-import Data.HMemDb.ForeignKeys (ForeignKey, delete, keyTarget, select, update)
-import Data.HMemDb.Persistence (getTable, putTable)
-import Data.HMemDb.RefContainer (RefContainer)
-import Data.HMemDb.Specs
-    (ColSpec, FullSpec(FullSpec, keySpec, tabSpec),
-     Keys(Keys), KeySpec, TableSpec(TableSpec),
-     key, nonunique, val, unique, (:+:)((:+:)))
-import Data.HMemDb.Tables (Table, foldTable_)
-import Data.HMemDb.TableVarId (TableVarId, idToVar, tableIds, tvIdTarget, varToId)
-import Data.HMemDb.TableVars
-    (TableVar, TableVarS,
-     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget)
+{-# 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, key, tref,+-- ** Key specs+     KeySpec, unique, nonunique,+-- * Creating tables+     createTable,+     Keys(Keys), RefContainer, IsKeySpec, (:+:)((:+:)),+     CreateTable,+-- * Basic operations+     insert, select, delete, update,+-- * Serialization+     getTable, 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 (getTable, putTable)+import Data.HMemDb.RefContainer (RefContainer)+import Data.HMemDb.Specs+    (ColSpec, FullSpec(FullSpec, keySpec, tabSpec),+     Keys(Keys), KeySpec, TableSpec,+     key, 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)

@@ -9,16 +9,15 @@     ) where
 import Control.Applicative (liftA2, (<$>))
 import Control.Compose (Id, unId, (:.))
-import Control.Concurrent.STM (TVar, readTVar)
-import Control.Monad.Trans.Class (lift)
+import Control.Concurrent.STM (TVar)
 import Data.Binary (Binary(get, put), Get, Put)
-import qualified Data.Map as M (Map, lookup)
-import Data.HMemDb.Binary (MS)
-import Data.HMemDb.References (CRef(CRef), Ref(Ref, refContent, refIndex))
-import Data.HMemDb.Utils (liftMaybe, oBind, pureO)
+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 (M.Map Integer (TVar (Maybe r))) -> TableGetData a
+    TableGetData :: (r -> MS a) -> TVar (Map Integer (TVar (Maybe r))) -> TableGetData a
 data TableRefs r where
     TRNil :: TableRefs ()
     TRProxy :: TableRefs (Proxy r)
@@ -43,12 +42,9 @@     isIdTR = id
     isIdTRBack = id
 tableVarBinGet :: TableRefs (CRef a) -> Integer -> MS (CRef a)
-tableVarBinGet (TRVar (TableGetData to cnt)) n =
-    do mp <- lift $ readTVar cnt
-       ref <- liftMaybe $ M.lookup n mp
-       return $ CRef (Ref {refContent = ref, refIndex = n}) to
+tableVarBinGet (TRVar (TableGetData to cnt)) n = readCRef to cnt n
 instance Bin (CRef a) where
-    binPut (CRef ref _) = put $ refIndex ref
+    binPut cref = put $ cRefIndex cref
     binGet tref = pureO get `oBind` tableVarBinGet tref
 instance (Bin r1, Bin r2) => Bin (r1, r2) where
     binPut (r1, r2) = binPut r1 >> binPut r2

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

@@ -2,32 +2,25 @@ module Data.HMemDb.CreateTable (CreateTable(makeTable), IsKeySpec, createTable) where
 import Control.Applicative ((<$>))
 import Control.Arrow (first)
-import Control.Concurrent.STM (STM, newTVar, readTVar)
-import Control.Monad.Trans.Class (lift)
-import qualified Data.Map as M (empty, lookup)
+import Control.Concurrent.STM (STM, newTVar)
+import qualified Data.Map as M (empty)
 import Data.HMemDb.Bin (Bin)
 import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))
 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(FullSpec, keySpec, tabSpec),
-     Keys(Keys), KeySpec(KeySpec), TableSpec(TableSpec),
-     makeRC, (:+:)((:+:)))
+    (FullSpec(keySpec, tabSpec), Keys(Keys), KeySpec(KeySpec), makeRC, (:+:)((:+:)))
 import Data.HMemDb.Tables
-    (PreTable(PreTable, tabContent, tabConv, tabCount, tabIndices), Table(Table))
-import Data.HMemDb.Utils (liftMaybe)
+    (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 => PreRefConv r a a -> u a KeySpec -> STM (PreTable r a, u a ForeignKey)
 instance CreateTable Keys where
     makeTable pr ~Keys =
-        do count <- newTVar 0
-           content <- newTVar M.empty
-           let pt =
-                   PreTable
-                   {tabCount = count, tabConv = pr, tabContent = content, tabIndices = []}
+        do pt <- emptyPreTable pr
            return (pt, Keys)
 -- | This class is here for technical reasons; it has just one instance.
 class IsKeySpec ks where
@@ -40,9 +33,8 @@         do ~(pt, uf) <- makeTable pr uk
            ii <- newTVar M.empty
            tv <- newTVar M.empty
-           let lkp i = lift (readTVar tv) >>= liftMaybe . M.lookup i
            let pt' = pt {tabIndices = KeyBack (PreKeyBack h ii tv) : tabIndices pt}
-           return (pt', uf :+: ForeignKey pt' lkp)
+           return (pt', uf :+: ForeignKey pt' (readTVarMap tv))
 instance (CreateTable u, IsKeySpec ks) => CreateTable (u :+: ks) where
     makeTable = makeTableKS
 createTable :: CreateTable u => FullSpec a u -> STM (Table a, u a ForeignKey)
@@ -52,5 +44,6 @@ -- 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 (FullSpec {tabSpec = TableSpec cs, keySpec = ks}) =
-    case makeRC cs of RefConv _ pr -> first Table <$> makeTable pr ks
+createTable fs =
+    case makeRC $ tabSpec fs of
+      RefConv _ pr -> first Table <$> makeTable pr (keySpec fs)

@@ -8,7 +8,7 @@ import Control.Monad.Trans.Maybe (runMaybeT)
 import Data.Foldable (Foldable)
 import Data.HMemDb.Bin (Bin)
-import Data.HMemDb.Binary (MS)
+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)

@@ -10,15 +10,18 @@ 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(runContT))
+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.Binary (MS)
+import Data.HMemDb.MapTVar (MS, liftMaybe)
 import Data.HMemDb.RefContainer (RefContainer(insRef, delRef))
 import Data.HMemDb.References (Ref(refIndex))
-import Data.HMemDb.Utils (brackets, liftMaybe)
+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)

@@ -0,0 +1,13 @@+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

@@ -12,8 +12,7 @@ import Data.HMemDb.CreateTable (CreateTable(makeTable))
 import Data.HMemDb.ForeignKeys (ForeignKey)
 import Data.HMemDb.RefConverter (RefConv(RefConv))
-import Data.HMemDb.Specs
-    (FullSpec(FullSpec, keySpec, tabSpec), TableSpec(TableSpec), makeRC)
+import Data.HMemDb.Specs (FullSpec(keySpec, tabSpec), makeRC)
 import Data.HMemDb.Tables
     (PreTable(tabContent, tabCount), Table(Table), insertRefIntoTable)
 import Data.HMemDb.Utils
@@ -46,12 +45,12 @@ -- ^ This function reads the table from the ByteString.
 -- As the table structure is NOT stored,
 -- one should provide the same one that was used to create this table
-getTable (FullSpec {tabSpec = TableSpec cs, keySpec = ks}) =
-    case makeRC cs of
+getTable fs =
+    case makeRC $ tabSpec fs of
       RefConv tr pr ->
           let genPairs =
                   (\result tC pairs -> (result, (tC, pairs)))
-                  <$> oPure (makeTable pr ks)
+                  <$> oPure (makeTable pr $ keySpec fs)
                   <*> pureO get
                   <*> (get `bindO` replicateO ((,) <$> pureO get <*> binGet tr))
               insPairs ~((pt, uf), (tC, pairs)) =

@@ -2,7 +2,7 @@ import Control.Compose (Id(Id))
 import Data.Foldable (Foldable)
 import Data.Set (Set, delete, empty, insert, singleton)
-import Data.HMemDb.References
+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

@@ -4,7 +4,7 @@ import Control.Applicative (Applicative(pure, (<*>)))
 import Control.Monad (liftM2)
 import Data.HMemDb.Bin (Bin, TableRefs(TRNil, TRPair))
-import Data.HMemDb.Binary (MS)
+import Data.HMemDb.MapTVar (MS)
 data PreRefConv r input output =
     PreRefConv {rcFrom :: input -> MS r, rcTo :: r -> MS output}
 data RefConv input output where

@@ -1,16 +1,17 @@ {-# LANGUAGE GADTs#-}
 module Data.HMemDb.References
-    (CRef(CRef), Ref(Ref, refContent, refIndex), deCRef, deRef) where
+    (CRef(CRef), Ref(Ref, refContent, refIndex),
+     cRefIndex, deCRef, deRef, readCRef) where
 import Control.Concurrent.STM (TVar, readTVar)
-import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT(MaybeT))
 import Data.Function (on)
-import Data.HMemDb.Binary (MS)
-import Data.HMemDb.Utils (liftMaybe)
+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 = lift (readTVar $ refContent ref) >>= liftMaybe
+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
@@ -18,3 +19,7 @@ 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

@@ -5,10 +5,11 @@      FullSpec(FullSpec, keySpec, tabSpec),
      Keys(Keys),
      KeySpec(KeySpec),
-     TableSpec(TableSpec),
+     TableSpec,
      key,
      makeRC,
      nonunique,
+     tref,
      val,
      unique,
      (:+:)((:+:))) where
@@ -20,55 +21,63 @@     (Proxy(Proxy, unProxy), TableGetData(TableGetData), TableRefs(TRProxy, TRVar))
 import Data.HMemDb.ForeignKeys (ForeignKey, getCRef, keyTarget)
 import Data.HMemDb.RefConverter (PreRefConv(PreRefConv, rcFrom, rcTo), RefConv(RefConv))
-import Data.HMemDb.References (deCRef)
+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 col => (input -> 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
-    CSVal ::
-        Binary col => (input -> col)
-        -> ColSpec input (col -> output)
-        -> ColSpec input output
-    CSKey ::
-        Ord i => (input -> i)
-        -> ForeignKey Id i col
-        -> ColSpec input (col -> 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 (CSVal g c) = CSVal g $ (h .) <$> c
-    fmap h (CSKey g f c) = CSKey g f $ (h .) <$> c
+    fmap h (CSPart csp c) = CSPart csp $ (h .) <$> c
 instance Applicative (ColSpec input) where
     pure = CSEnd
     CSEnd h <*> c = h <$> c
-    CSVal g c <*> c' = CSVal g $ flip <$> c <*> c'
-    CSKey g f c <*> c' = CSKey g f $ flip <$> c <*> 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 h = CSVal h $ pure id
+val h = CSPart (TSPVal h) (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 = CSKey h k $ pure id
-newtype TableSpec a = TableSpec (ColSpec a a)
+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)
 --
-makeRC :: ColSpec input output -> RefConv input output
-makeRC (CSEnd output) = pure output
-makeRC (CSVal g c) =
-    makeRC c <*>
+cspToRC :: TableSpecPart input col -> RefConv input col
+cspToRC (TSPVal g) =
     RefConv TRProxy (PreRefConv {rcFrom = return . Proxy . g, rcTo = return . unProxy})
-makeRC (CSKey g f c) =
+cspToRC (TSPKey g f) =
     case keyTarget f of
       Table pt ->
           let tgd = TableGetData (rcTo $ tabConv pt) (tabContent pt)
-          in makeRC c <*>
-             RefConv (TRVar $ tgd) (PreRefConv {rcFrom = getCRef f . g, rcTo = deCRef})
+          in RefConv (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 (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

@@ -1,21 +1,11 @@-module Data.HMemDb.TableVarId (TableVarId, idToVar, tableIds, tvIdTarget, varToId) where+module Data.HMemDb.TableVarId (TableVarId(TableVarId), idToVar, varToId) where import Control.Compose (Id(Id), unId)-import Control.Concurrent.STM (readTVar)-import Control.Monad.Trans.Class (lift) import Data.Function (on)-import qualified Data.Map as M (lookup)-import Data.HMemDb.Binary (MS)-import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))+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))-import Data.HMemDb.Utils (liftMaybe)-data TableVarId a =-    TableVarId-    {-      unTVId :: Integer,-      tvIdTarget :: Table a -- ^ 'Table' this id points to.-    }+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@@ -23,23 +13,10 @@ 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 pt) =-    TableVarId {unTVId = refIndex (unId iref), tvIdTarget = Table pt}-idToVar :: TableVarId a -> MS (TableVar a)+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 tvId =-    case tvIdTarget tvId of-      Table pt ->-          do mp <- lift $ readTVar $ tabContent pt-             let i = unTVId tvId-             tv <- liftMaybe $ M.lookup i mp-             return $ TableVar (Id Ref {refContent = tv, refIndex = i}) pt-tableIds :: Table a -> ForeignKey Id (TableVarId a) a--- ^ If you want to use 'TableVarId' as a column type in a table,--- you'd need a 'ForeignKey'. This function provides one.-tableIds (Table pt) =-    ForeignKey pt $ \tvId -> do-      mp <- lift (readTVar $ tabContent pt)-      let i = unTVId tvId-      tv <- liftMaybe $ M.lookup i mp-      return $ Id Ref {refContent = tv, refIndex = i}+idToVar (Table pt) tvId =+    do let i = unTVId tvId+       tv <- readTVarMap (tabContent pt) i+       return $ TableVar (Id Ref {refContent = tv, refIndex = i}) pt

@@ -10,7 +10,7 @@ import Data.Map (toAscList)
 import Data.Set (Set, fromAscList)
 import Data.HMemDb.Bin(Bin)
-import Data.HMemDb.Binary (MS)
+import Data.HMemDb.MapTVar (MS)
 import Data.HMemDb.RefConverter (rcTo)
 import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
 import Data.HMemDb.Tables

@@ -1,9 +1,10 @@ {-# LANGUAGE GADTs #-}
 module Data.HMemDb.Tables
     (
-     PreTable(PreTable, tabCount, tabContent, tabConv, tabIndices),
+     PreTable(tabCount, tabContent, tabConv, tabIndices),
      Table(Table),
      deleteFromTable,
+     emptyPreTable,
      foldTable_,
      insertIntoTable,
      insertRefIntoTable,
@@ -13,13 +14,12 @@ 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, insert)
+import qualified Data.Map as M (Map, delete, empty, insert)
 import Data.HMemDb.Bin (Bin)
-import Data.HMemDb.Binary (MS)
+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)
-import Data.HMemDb.Utils (liftMaybe)
 data PreTable r a =
     PreTable
     {
@@ -28,6 +28,18 @@       tabContent :: TVar (M.Map Integer (TVar (Maybe r))),
       tabIndices :: [KeyBack r a]
     }
+emptyPreTable :: PreRefConv r a a -> STM (PreTable r a)
+emptyPreTable pr =
+    do count <- newTVar 0
+       content <- newTVar M.empty
+       let pt =
+               PreTable {
+                 tabCount = count,
+                 tabConv = pr,
+                 tabContent = content,
+                 tabIndices = []
+               }
+       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

@@ -2,10 +2,8 @@ module Data.HMemDb.Utils
     (
      bindO,
-     brackets,
      enumElem,
      fixArray,
-     liftMaybe,
      liftPure,
      oBind,
      pureO,
@@ -13,14 +11,11 @@     ) where
 import Control.Applicative (Applicative(pure), (<$>), (<*>))
 import Control.Compose (oFmap, oPure, unO, (:.)(O))
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Cont (Cont, ContT(ContT), cont)
-import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
+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)
-liftMaybe :: Monad m => Maybe a -> MaybeT m a
-liftMaybe = MaybeT . return
 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
@@ -35,7 +30,3 @@ 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)
-brackets :: Monad m => m a -> (a -> m r) -> ContT r m ()
-brackets before after =
-    do a <- lift before
-       ContT $ \f -> f () >> after a