module Data.HMemDb.ForeignKeys
(ForeignKey(ForeignKey), delete, getCRef, keyTarget, select, update) where
import Control.Compose (Id, unId)
import Control.Concurrent.STM (STM, TVar, readTVar)
import Control.Monad (void)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
import Data.Foldable (Foldable)
import qualified Data.Map as M (Map, lookup)
import Data.HMemDb.Bin (Bin)
import Data.HMemDb.Binary (MS)
import Data.HMemDb.RefConverter (rcTo)
import Data.HMemDb.References (CRef(CRef), Ref)
import Data.HMemDb.Tables (PreTable, Table(Table), tabConv)
import Data.HMemDb.TableVars (TableVarS(TableVar), deleteTV, forTV, modifyTV)
import Data.HMemDb.Utils (liftMaybe)
data ForeignKey s i a where
ForeignKey ::
Bin r => PreTable r a
-> TVar (M.Map i (s (Ref r)))
-> ForeignKey s i a
select :: Ord i => ForeignKey s i a -> i -> MS (TableVarS s a)
select (ForeignKey pt tv) i =
do mp <- lift $ readTVar tv
s <- liftMaybe $ M.lookup i mp
return $ TableVar s pt
getCRef :: Ord i => ForeignKey Id i a -> i -> MS (CRef a)
getCRef (ForeignKey pt tv) i =
do mp <- lift $ readTVar tv
iref <- liftMaybe $ M.lookup i mp
return $ CRef (unId iref) $ rcTo (tabConv pt)
delete :: (Foldable s, Ord i) => ForeignKey s i a -> i -> STM ()
delete f i = void $ runMaybeT $ select f i >>= forTV (lift . runMaybeT . deleteTV)
update :: Ord i => ForeignKey Id i a -> i -> a -> MS a
update f i new = select f i >>= modifyTV new
keyTarget :: ForeignKey s i a -> Table a
keyTarget (ForeignKey pt _) = Table pt