{-# LANGUAGE GADTs #-}
module Data.HMemDb.TableVars 
    (TableVar, TableVarS(TableVar), deleteTV, forTV, insert, modifyTV, readTV) where
import Control.Applicative (Applicative)
import Control.Compose (Id(Id), unId)
import Control.Monad (mplus, mzero)
import Data.Foldable (Foldable, for_)
import Data.HMemDb.Binary (MS)
import Data.HMemDb.RefConverter (rcTo)
import Data.HMemDb.References (Ref, deRef)
import Data.HMemDb.Tables
    (PreTable(tabConv), Table(Table), deleteFromTable, insertIntoTable, modifyInTable)
-- | This is a more generic type, which represents a set of values in the same table.
data TableVarS s a where
    TableVar :: s (Ref r) -> PreTable r a -> TableVarS s a
type TableVar = TableVarS Id
-- ^ This type represents references to individual values in the table.
-- It is returned by 'insert' and 'Data.HMemDb.select' functions.
readTV :: TableVar a -> MS a
-- ^ This function reads the value from the table.
-- It fails if the value was removed before or became invalid.
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
-- ^ This function removes the value from whatever table it's in.
-- It returnes the original value, provided that it wasn't removed before
-- or invalidated by removing some other value this one references
-- with 'Data.HMemDb.ForeignKey'.
deleteTV (TableVar iref pt) = deleteFromTable (unId iref) pt
modifyTV :: a -> TableVar a -> MS a
-- ^ This function overrides the value with another one.
-- All indices referencing the original value would be referencing the new one.
-- It fails if the original value was removed before or became invalid.
modifyTV new (TableVar iref pt) = modifyInTable new (unId iref) pt
insert :: a -> Table a -> MS (TableVar a)
-- ^ This function inserts a new value into the table and gives a 'TableVar' back.
-- Failure indicates that one of the unique indices for this value
-- coincides with the same index of another value already present in the table.
-- It won't happen for non-unique indices.
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 ()
-- ^ This function iterates through all elements of the set.
forTV h (TableVar s pt) = for_ s $ \ref -> h $ TableVar (Id ref) pt