hmemdb 0.1.0.3 → 0.1.0.4

raw patch · 5 files changed

+19/−25 lines, 5 files

Files

• hmemdb.cabal +1/−1
• src/Data/HMemDb.hs +4/−2
• src/Data/HMemDb/CreateTable.hs +6/−3
• src/Data/HMemDb/ForeignKeys.hs +7/−14
• src/Data/HMemDb/TableVars.hs +1/−5

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hmemdb
-version:             0.1.0.3
+version:             0.1.0.4
 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

@@ -7,12 +7,14 @@      MS, GS, SP,
 -- * Tables
      Table, foldTable_,
-     TableVar, TableVarS, IsId,
+     TableVar, TableVarS,
      tableVarTarget,
      forTV,
      deleteTV, modifyTV, readTV,
      selectAll,
      ForeignKey, keyTarget,
+-- * Ids
+     TableVarId, idToVar, varToId, tableIds,
 -- * Specs
      FullSpec(FullSpec, keySpec, tabSpec),
 -- ** Table specs
@@ -29,7 +31,6 @@      getTable, putTable,
     )
 where
-import Data.HMemDb.Bin (IsId)
 import Data.HMemDb.Binary (GS, MS, SP)
 import Data.HMemDb.CreateTable (CreateTable, IsKeySpec, createTable)
 import Data.HMemDb.ForeignKeys (ForeignKey, delete, keyTarget, select, update)
@@ -40,6 +41,7 @@      Keys(Keys), KeySpec, TableSpec(TableSpec),
      key, nonunique, val, unique, (:+:)((:+:)))
 import Data.HMemDb.Tables (Table, foldTable_)
+import Data.HMemDb.TableVarId (TableVarId, idToVar, varToId, tableIds)
 import Data.HMemDb.TableVars
     (TableVar, TableVarS,
      deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget)

@@ -2,8 +2,9 @@ module Data.HMemDb.CreateTable (CreateTable(makeTable), IsKeySpec, createTable) where
 import Control.Applicative ((<$>))
 import Control.Arrow (first)
-import Control.Concurrent.STM (STM, newTVar)
-import qualified Data.Map as M (empty)
+import Control.Concurrent.STM (STM, newTVar, readTVar)
+import Control.Monad.Trans.Class (lift)
+import qualified Data.Map as M (empty, lookup)
 import Data.HMemDb.Bin (Bin)
 import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))
 import Data.HMemDb.KeyBackends (KeyBack(KeyBack), PreKeyBack(PreKeyBack))
@@ -15,6 +16,7 @@      makeRC, (:+:)((:+:)))
 import Data.HMemDb.Tables
     (PreTable(PreTable, tabContent, tabConv, tabCount, tabIndices), Table(Table))
+import Data.HMemDb.Utils (liftMaybe)
 -- | This is a class of sets of 'Data.HMemDb.KeySpec's and 'Data.HMemDb.ForeignKey's
 class CreateTable u where
     makeTable ::
@@ -38,8 +40,9 @@         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' tv)
+           return (pt', uf :+: ForeignKey pt' lkp)
 instance (CreateTable u, IsKeySpec ks) => CreateTable (u :+: ks) where
     makeTable = makeTableKS
 createTable :: CreateTable u => FullSpec a u -> STM (Table a, u a ForeignKey)

@@ -2,45 +2,38 @@ module Data.HMemDb.ForeignKeys
     (ForeignKey(ForeignKey), delete, getCRef, keyTarget, select, update) where
 import Control.Compose (Id, unId)
-import Control.Concurrent.STM (STM, TVar, readTVar)
+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 qualified Data.Map as M (Map, lookup)
 import Data.HMemDb.Bin (Bin)
 import Data.HMemDb.Binary (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)
-import Data.HMemDb.Utils (liftMaybe)
 -- | 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.
 data ForeignKey s i a where
-    ForeignKey ::
-        Bin r => PreTable r a
-        -> TVar (M.Map i (s (Ref r)))
-        -> ForeignKey s i a
+    ForeignKey :: Bin r => PreTable r a -> (i -> MS (s (Ref r))) -> ForeignKey s i a
 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 pt tv) i =
-    do mp <- lift $ readTVar tv
-       s <- liftMaybe $ M.lookup i mp
+select (ForeignKey pt lkp) i =
+    do s <- lkp i
        return $ TableVar s pt
 getCRef :: Ord i => ForeignKey Id i a -> i -> MS (CRef a)
-getCRef (ForeignKey pt tv) i =
-    do mp <- lift $ readTVar tv
-       iref <- liftMaybe $ M.lookup i mp
+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 >>= forTV (lift . runMaybeT . deleteTV)
+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.

@@ -1,13 +1,12 @@ {-# LANGUAGE GADTs #-}
 module Data.HMemDb.TableVars 
     (TableVar, TableVarS(TableVar),
-     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget) where
+     deleteTV, forTV, getVarId, 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.Function (on)
 import Data.Map (toAscList)
 import Data.Set (Set, fromAscList)
 import Data.HMemDb.Bin(Bin, IsId(isId))
@@ -25,9 +24,6 @@ -- It is returned by 'insert' and 'Data.HMemDb.select' functions.
 getVarId :: IsId s => TableVarS s a -> Integer
 getVarId (TableVar s _) = refIndex $ isId s
-instance IsId s => Eq (TableVarS s a) where (==) = (==) `on` getVarId
--- ^ 'TableVar's from different 'Table's may coincidentally appear as equal.
-instance IsId s => Ord (TableVarS s a) where compare = compare `on` getVarId
 tableVarTarget :: TableVarS s a -> Table a
 -- ^ This function returns the 'Table' that the 'TableVar' is from.
 tableVarTarget (TableVar _ pt) = Table pt