module Data.HMemDb.ForeignKeys
(ForeignKey(ForeignKey), PreForeignKey(PreForeignKey),
delete, getCRef, keyTarget, makeForeignKey, select, update) where
import Control.Compose (Id, unId)
import Control.Concurrent.STM (STM)
import Control.Monad (void)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
import Data.Foldable (Foldable)
import Data.HMemDb.Bin (Bin)
import Data.HMemDb.MapTVar (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)
newtype PreForeignKey r s i a = PreForeignKey {runPreForeignKey :: i -> MS (s (Ref r))}
data ForeignKey s i a where
ForeignKey :: Bin r -> PreTable r a -> (i -> MS (s (Ref r))) -> ForeignKey s i a
makeForeignKey :: Bin r -> PreTable r a -> PreForeignKey r s i a -> ForeignKey s i a
makeForeignKey b pt pfk = ForeignKey b pt $ runPreForeignKey pfk
select :: Ord i => ForeignKey s i a -> i -> MS (TableVarS s a)
select (ForeignKey b pt lkp) i =
do s <- lkp i
return $ TableVar b s pt
getCRef :: Ord i => ForeignKey Id i a -> i -> MS (CRef a)
getCRef (ForeignKey _ pt lkp) i =
do iref <- lkp i
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 >>= lift . forTV (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 b pt _) = Table b pt