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 pt pfk = ForeignKey pt $ runPreForeignKey pfk
select :: Ord i => ForeignKey s i a -> i -> MS (TableVarS s a)
select (ForeignKey pt lkp) i =
do s <- lkp i
return $ TableVar 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 pt _) = Table pt