module Data.HMemDb.TableVars
(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(Ref, refContent, refIndex), deRef)
import Data.HMemDb.Tables
(PreTable(tabContent, tabConv), Table(Table),
deleteFromTable, insertIntoTable, modifyInTable)
data TableVarS s a where
TableVar :: Bin r => s (Ref r) -> PreTable r a -> TableVarS s a
type TableVar = TableVarS Id
getVarId :: IsId s => TableVarS s a -> Integer
getVarId (TableVar s _) = refIndex $ isId s
instance IsId s => Eq (TableVarS s a) where (==) = (==) `on` getVarId
instance IsId s => Ord (TableVarS s a) where compare = compare `on` getVarId
tableVarTarget :: TableVarS s a -> Table a
tableVarTarget (TableVar _ pt) = Table pt
readTV :: TableVar a -> MS a
readTV (TableVar iref pt) =
do let ref = unId iref
r <- deRef ref
rcTo (tabConv pt) r `mplus` (deleteFromTable ref pt >> mzero)
deleteTV :: TableVar a -> MS a
deleteTV (TableVar iref pt) = deleteFromTable (unId iref) pt
modifyTV :: a -> TableVar a -> MS a
modifyTV new (TableVar iref pt) = modifyInTable new (unId iref) pt
insert :: a -> Table a -> MS (TableVar a)
insert a (Table pt) =
do ref <- insertIntoTable a pt
return $ TableVar (Id ref) pt
forTV :: (Foldable s, Applicative f) => (TableVar a -> f b) -> TableVarS s a -> f ()
forTV h (TableVar s pt) = for_ s $ \ref -> h $ TableVar (Id ref) pt
selectAll :: Table a -> STM (TableVarS Set a)
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