module Data.HMemDb.Tables
(
PreTable(tabCount, tabContent, tabConv, tabIndices),
Table(Table),
deleteFromTable,
emptyPreTable,
foldTable_,
insertIntoTable,
insertRefIntoTable,
modifyInTable
) where
import Control.Concurrent.STM (STM, TVar, modifyTVar', newTVar, readTVar, writeTVar)
import Control.Monad.Trans.Class (lift)
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.MapTVar (MS, liftMaybe)
import Data.HMemDb.KeyBackends (KeyBack, deleteFromKeys, insertIntoKeys, modifyInKeys)
import Data.HMemDb.RefConverter (PreRefConv(rcFrom, rcTo))
import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
data PreTable r a =
PreTable
{
tabCount :: TVar Integer,
tabConv :: PreRefConv r a a,
tabContent :: TVar (M.Map Integer (TVar (Maybe r))),
tabIndices :: [KeyBack r a]
}
emptyPreTable :: PreRefConv r a a -> STM (PreTable r a)
emptyPreTable pr =
do count <- newTVar 0
content <- newTVar M.empty
let pt =
PreTable {
tabCount = count,
tabConv = pr,
tabContent = content,
tabIndices = []
}
return pt
data Table a where Table :: Bin r => PreTable r a -> Table a
insertTVarIntoTable :: a -> Integer -> TVar (Maybe r) -> PreTable r a -> MS (Ref r)
insertTVarIntoTable a n tv pt =
do let ref = Ref {refContent = tv, refIndex = n}
insertIntoKeys a ref $ tabIndices pt
lift $ modifyTVar' (tabContent pt) $ M.insert n tv
return ref
insertIntoTable :: a -> PreTable r a -> MS (Ref r)
insertIntoTable a pt =
do n <- lift $ readTVar $ tabCount pt
content <- rcFrom (tabConv pt) a >>= lift . newTVar . Just
ref <- insertTVarIntoTable a n content pt
lift $ writeTVar (tabCount pt) $ n+1
return ref
insertRefIntoTable :: PreTable r a -> (Integer, r) -> MS (Ref r)
insertRefIntoTable pt ~(n, r) =
do tv <- lift $ newTVar $ Just r
a <- rcTo (tabConv pt) r
insertTVarIntoTable a n tv pt
deleteFromTable :: Ref r -> PreTable r a -> MS a
deleteFromTable ref pt =
do a <- lift $ runMaybeT $ deRef ref >>= rcTo (tabConv pt)
lift $ do
modifyTVar' (tabContent pt) $ M.delete $ refIndex ref
deleteFromKeys ref $ tabIndices pt
writeTVar (refContent ref) Nothing
liftMaybe a
modifyInTable :: a -> Ref r -> PreTable r a -> MS a
modifyInTable new ref pt =
do old <- deRef ref >>= rcTo (tabConv pt)
r <- rcFrom (tabConv pt) new
lift $ modifyInKeys new ref $ tabIndices pt
lift $ writeTVar (refContent ref) $ Just r
return old
foldTable_ :: (a -> MS b) -> Table a -> STM ()
foldTable_ h (Table pt) =
do mp <- readTVar $ tabContent pt
for_ mp $ \tv -> runMaybeT $ MaybeT (readTVar tv) >>= rcTo (tabConv pt) >>= h