packages feed

hmemdb 0.1.0.2 → 0.1.0.3

raw patch · 5 files changed

+47/−35 lines, 5 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

+ Data.HMemDb: class IsId s
+ Data.HMemDb: selectAll :: Table a -> STM (TableVarS Set a)
+ Data.HMemDb: tableVarTarget :: TableVarS s a -> Table a

Files

hmemdb.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hmemdb
-version:             0.1.0.2
+version:             0.1.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
@@ -4,48 +4,32 @@ -- with certain automatically updated indices (foreign keys).
 module Data.HMemDb
     (
-     MS,
-     GS,
-     SP,
+     MS, GS, SP,
 -- * Tables
-     Table,
-     foldTable_,
-     TableVar,
-     TableVarS,
+     Table, foldTable_,
+     TableVar, TableVarS, IsId,
+     tableVarTarget,
      forTV,
-     deleteTV,
-     modifyTV,
-     readTV,
-     ForeignKey,
-     keyTarget,
+     deleteTV, modifyTV, readTV,
+     selectAll,
+     ForeignKey, keyTarget,
 -- * Specs
      FullSpec(FullSpec, keySpec, tabSpec),
 -- ** Table specs
-     TableSpec(TableSpec),
-     ColSpec,
-     val,
-     key,
+     TableSpec(TableSpec), ColSpec, val, key,
 -- ** Key specs
-     KeySpec,
-     unique,
-     nonunique,
+     KeySpec, unique, nonunique,
 -- * Creating tables
      createTable,
-     Keys(Keys),
-     RefContainer,
-     IsKeySpec,
-     (:+:)((:+:)),
+     Keys(Keys), RefContainer, IsKeySpec, (:+:)((:+:)),
      CreateTable,
 -- * Basic operations
-     insert,
-     select,
-     delete,
-     update,
+     insert, select, delete, update,
 -- * Serialization
-     getTable,
-     putTable,
+     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)
@@ -57,4 +41,5 @@      key, nonunique, val, unique, (:+:)((:+:)))
 import Data.HMemDb.Tables (Table, foldTable_)
 import Data.HMemDb.TableVars
-    (TableVar, TableVarS, deleteTV, forTV, insert, modifyTV, readTV)
+    (TableVar, TableVarS,
+     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget)
src/Data/HMemDb/Bin.hs view
@@ -2,6 +2,7 @@ module Data.HMemDb.Bin
     (
      Bin(binGet, binPut),
+     IsId(isId),
      Proxy(Proxy, unProxy),
      TableGetData(TableGetData),
      TableRefs(TRNil, TRPair, TRProxy, TRVar)
@@ -32,6 +33,7 @@ instance Binary r => Bin (Proxy r) where
     binPut = put . unProxy
     binGet TRProxy = pureO $ Proxy <$> get
+-- | This class is here for technical reasons, it should only have one instance whatsoever.
 class IsId s where
     isId :: s a -> a
     isIdTR :: TableRefs (f s a) -> TableRefs (f Id a)
src/Data/HMemDb/References.hs view
@@ -12,5 +12,9 @@ deRef :: Ref r -> MS r
 deRef ref = lift (readTVar $ refContent ref) >>= liftMaybe
 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
src/Data/HMemDb/TableVars.hs view
@@ -1,21 +1,36 @@ {-# LANGUAGE GADTs #-}
 module Data.HMemDb.TableVars 
-    (TableVar, TableVarS(TableVar), deleteTV, forTV, insert, modifyTV, readTV) where
+    (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.Function (on)
+import Data.Map (toAscList)
+import Data.Set (Set, fromAscList)
+import Data.HMemDb.Bin(Bin, IsId(isId))
 import Data.HMemDb.Binary (MS)
 import Data.HMemDb.RefConverter (rcTo)
-import Data.HMemDb.References (Ref, deRef)
+import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
 import Data.HMemDb.Tables
-    (PreTable(tabConv), Table(Table), deleteFromTable, insertIntoTable, modifyInTable)
+    (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 :: s (Ref r) -> PreTable r a -> TableVarS s a
+    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.
+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
 readTV :: TableVar a -> MS a
 -- ^ This function reads the value from the table.
 -- It fails if the value was removed before or became invalid.
@@ -45,3 +60,9 @@ 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 s pt) = for_ s $ \ref -> h $ TableVar (Id ref) pt
+selectAll :: Table a -> STM (TableVarS Set a)
+-- ^ This function gives the set of all values in the table.
+selectAll (Table pt) =
+    do mp <- readTVar $ tabContent pt
+       let makeRef ~(n, tv) = Ref {refContent = tv, refIndex = n}
+       return $ TableVar (fromAscList $ map makeRef $ toAscList mp) pt