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 +1/−1
- src/Data/HMemDb.hs +15/−30
- src/Data/HMemDb/Bin.hs +2/−0
- src/Data/HMemDb/References.hs +4/−0
- src/Data/HMemDb/TableVars.hs +25/−4
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