{-# LANGUAGE GADTs #-}
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)
-- | This is a type of foreign keys. Each foreign key points to one table.
-- It is used to find the values in this table using 'select'.
-- Foreign keys are created at the same time 'Table's are.
-- They can't be added afterwards.
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)
-- ^ This function searches for some particular index in the table.
-- It fails if there is no value with that index. Empty set of values is never returned.
-- For non-unique indices it returns the set of 'Data.HMemDb.TableVar's.
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 ()
-- ^ This function deletes the value from the table. It won't be accessible anymore.
-- It never fails; nonexistent values are silently skipped.
delete f i = void $ runMaybeT $ select f i >>= lift . forTV (runMaybeT . deleteTV)
update :: Ord i => ForeignKey Id i a -> i -> a -> MS a
-- ^ This function overrides the existing value in the table with the new one.
-- All foreign keys pointing to the original value become pointing to the new value.
-- It returns the original value, which is no longer in the table.
-- Failure means that there was no such value.
update f i new = select f i >>= modifyTV new
keyTarget :: ForeignKey s i a -> Table a
-- ^ This function returns the table that the key points to.
keyTarget (ForeignKey pt _) = Table pt