hmemdb 0.2.0.1 → 0.2.0.2

raw patch · 4 files changed

+23/−12 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hmemdb.cabal +1/−1
• src/Data/HMemDb/CreateTable.hs +14/−8
• src/Data/HMemDb/ForeignKeys.hs +5/−1
• src/Data/HMemDb/Persistence.hs +3/−2

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

@@ -1,11 +1,11 @@ {-# LANGUAGE GADTs, TypeOperators #-}
-module Data.HMemDb.CreateTable (CreateTable(makeTable), IsKeySpec, createTable) where
-import Control.Applicative ((<$>))
-import Control.Arrow (first)
+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)
-import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))
+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)
@@ -17,26 +17,30 @@ -- | 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)
+        Bin 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
            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
         -> (u :+: ks) a KeySpec
-        -> STM (PreTable r a, (u :+: ks) a ForeignKey)
+        -> 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
            ii <- newTVar M.empty
            tv <- newTVar M.empty
            let pt' = pt {tabIndices = KeyBack (PreKeyBack h ii tv) : tabIndices pt}
-           return (pt', uf :+: ForeignKey pt' (readTVarMap tv))
+           return (pt', uf :+: PreForeignKey (readTVarMap tv))
 instance (CreateTable u, IsKeySpec ks) => CreateTable (u :+: ks) where
     makeTable = makeTableKS
+    fixKeys pt (uf :+: pfk) = fixKeys pt uf :+: makeForeignKey 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')
@@ -46,4 +50,6 @@ -- or to make a new 'Data.HMemDb.TableSpec'.
 createTable fs =
     case makeRC $ tabSpec fs of
-      RefConv _ pr -> first Table <$> makeTable pr (keySpec fs)
+      RefConv _ pr ->
+          do (pt, pfks) <- makeTable pr (keySpec fs)
+             return (Table pt, fixKeys pt pfks)

@@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-}
 module Data.HMemDb.ForeignKeys
-    (ForeignKey(ForeignKey), delete, getCRef, keyTarget, select, update) where
+    (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)
@@ -17,8 +18,11 @@ -- 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 pt pfk = ForeignKey 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.

@@ -9,7 +9,7 @@ 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))
+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)
@@ -53,8 +53,9 @@                   <$> oPure (makeTable pr $ keySpec fs)
                   <*> pureO get
                   <*> (get `bindO` replicateO ((,) <$> pureO get <*> binGet tr))
-              insPairs ~((pt, uf), (tC, pairs)) =
+              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