packages feed

hmemdb 0.2.0.2 → 0.2.0.3

raw patch · 5 files changed

+33/−42 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.HMemDb: getTable :: CreateTable u => FullSpec a u -> GS (Table a, u a ForeignKey)
+ Data.HMemDb: fillTable :: Table a -> GS ()

Files

hmemdb.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hmemdb
-version:             0.2.0.2
+version:             0.2.0.3
 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
src/Data/HMemDb.hs view
@@ -28,14 +28,14 @@ -- * Basic operations      insert, select, delete, update, -- * Serialization-     getTable, putTable,+     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 (getTable, putTable)+import Data.HMemDb.Persistence (fillTable, putTable) import Data.HMemDb.RefContainer (RefContainer) import Data.HMemDb.Specs     (ColSpec, FullSpec(FullSpec, keySpec, tabSpec),
src/Data/HMemDb/CreateTable.hs view
@@ -3,7 +3,7 @@     (CreateTable(makeTable, fixKeys), IsKeySpec, createTable) where
 import Control.Concurrent.STM (STM, newTVar)
 import qualified Data.Map as M (empty)
-import Data.HMemDb.Bin (Bin)
+import Data.HMemDb.Bin (Bin, TableRefs)
 import Data.HMemDb.ForeignKeys
     (ForeignKey, PreForeignKey(PreForeignKey), makeForeignKey)
 import Data.HMemDb.KeyBackends (KeyBack(KeyBack), PreKeyBack(PreKeyBack))
@@ -17,23 +17,27 @@ -- | 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 (PreForeignKey r))
+        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 pr ~Keys =
-        do pt <- emptyPreTable pr
+    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 ::
-        (Bin r, CreateTable u) => PreRefConv r a a
+        (Bin r, CreateTable u) => 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 pr (uk :+: KeySpec h) =
-        do ~(pt, uf) <- makeTable pr uk
+    makeTableKS tr pr (uk :+: KeySpec h) =
+        do ~(pt, uf) <- makeTable tr pr uk
            ii <- newTVar M.empty
            tv <- newTVar M.empty
            let pt' = pt {tabIndices = KeyBack (PreKeyBack h ii tv) : tabIndices pt}
@@ -50,6 +54,6 @@ -- or to make a new 'Data.HMemDb.TableSpec'.
 createTable fs =
     case makeRC $ tabSpec fs of
-      RefConv _ pr ->
-          do (pt, pfks) <- makeTable pr (keySpec fs)
+      RefConv tr pr ->
+          do (pt, pfks) <- makeTable tr pr (keySpec fs)
              return (Table pt, fixKeys pt pfks)
src/Data/HMemDb/Persistence.hs view
@@ -1,6 +1,5 @@-module Data.HMemDb.Persistence (getTable, putTable) where
+module Data.HMemDb.Persistence (fillTable, putTable) where
 import Control.Applicative (Applicative(pure, (<*>)), (<$>))
-import Control.Compose (oPure)
 import Control.Concurrent.STM (STM, TVar, readTVar, writeTVar)
 import Control.Monad.Trans.Cont (Cont, runCont, cont)
 import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
@@ -9,12 +8,8 @@ import qualified Data.Map as M (toAscList)
 import Data.HMemDb.Bin (Bin (binGet, binPut))
 import Data.HMemDb.Binary (GS, SP)
-import Data.HMemDb.CreateTable (CreateTable(makeTable, fixKeys))
-import Data.HMemDb.ForeignKeys (ForeignKey)
-import Data.HMemDb.RefConverter (RefConv(RefConv))
-import Data.HMemDb.Specs (FullSpec(keySpec, tabSpec), makeRC)
 import Data.HMemDb.Tables
-    (PreTable(tabContent, tabCount), Table(Table), insertRefIntoTable)
+    (PreTable(tabContent, tabCount, tabRefs), Table(Table), insertRefIntoTable)
 import Data.HMemDb.Utils
     (bindO, enumElem, fixArray, oBind, liftPure, pureO, replicateO)
 -- serialization
@@ -41,21 +36,11 @@ -- the index could be different after storing and restoring the table.
 putTable (Table pt) = runCont (putPreTable pt) pure
 -- deserialization
-getTable :: CreateTable u => FullSpec a u -> GS (Table a, u a ForeignKey)
+fillTable :: Table a -> GS ()
 -- ^ 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 fs =
-    case makeRC $ tabSpec fs of
-      RefConv tr pr ->
-          let genPairs =
-                  (\result tC pairs -> (result, (tC, pairs)))
-                  <$> oPure (makeTable pr $ keySpec fs)
-                  <*> pureO get
-                  <*> (get `bindO` replicateO ((,) <$> pureO get <*> binGet tr))
-              insPairs ~((pt, upf), (tC, pairs)) =
-                  do writeTVar (tabCount pt) tC
-                     let uf = fixKeys pt upf
-                     for_ pairs (runMaybeT . insertRefIntoTable pt)
-                     return (Table pt, uf)
-          in genPairs `oBind` insPairs
+fillTable (Table pt) = genPairs `oBind` insPairs where
+    genPair = (,) <$> pureO get <*> binGet (tabRefs pt)
+    genPairs = (,) <$> pureO get <*> (get `bindO` replicateO genPair)
+    insPairs ~(counter, pairs) =
+        do writeTVar (tabCount pt) counter
+           for_ pairs $ runMaybeT . insertRefIntoTable pt
src/Data/HMemDb/Tables.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE GADTs #-}
 module Data.HMemDb.Tables
     (
-     PreTable(tabCount, tabContent, tabConv, tabIndices),
+     PreTable(tabCount, tabContent, tabConv, tabIndices, tabRefs),
      Table(Table),
      deleteFromTable,
      emptyPreTable,
@@ -15,7 +15,7 @@ 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)
+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))
@@ -26,10 +26,11 @@       tabCount :: TVar Integer,
       tabConv :: PreRefConv r a a,
       tabContent :: TVar (M.Map Integer (TVar (Maybe r))),
-      tabIndices :: [KeyBack r a]
+      tabIndices :: [KeyBack r a],
+      tabRefs :: TableRefs r
     }
-emptyPreTable :: PreRefConv r a a -> STM (PreTable r a)
-emptyPreTable pr =
+emptyPreTable :: TableRefs r -> PreRefConv r a a -> STM (PreTable r a)
+emptyPreTable tr pr =
     do count <- newTVar 0
        content <- newTVar M.empty
        let pt =
@@ -37,7 +38,8 @@                  tabCount = count,
                  tabConv = pr,
                  tabContent = content,
-                 tabIndices = []
+                 tabIndices = [],
+                 tabRefs = tr
                }
        return pt
 data Table a where Table :: Bin r => PreTable r a -> Table a