{-# LANGUAGE GADTs #-}
module Data.HMemDb.TableVars 
    (TableVar, TableVarS(TableVar),
     deleteTV, forTV, insert, modifyTV, readTV, selectAll, tableVarTarget) where
import Control.Applicative (Applicative)
import Control.Concurrent.STM (STM, readTVar)
import Control.Compose (Id(Id), unId)
import Control.Monad (mplus, mzero)
import Data.Foldable (Foldable, for_)
import Data.Map (toAscList)
import Data.Set (Set, fromAscList)
import Data.HMemDb.Bin(Bin)
import Data.HMemDb.MapTVar (MS)
import Data.HMemDb.RefConverter (rcTo)
import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
import Data.HMemDb.Tables
    (PreTable(tabContent, 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 :: Bin r => 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.
tableVarTarget :: TableVarS s a -> Table a
-- ^ This function returns the 'Table' that the 'TableVar' is from.
tableVarTarget (TableVar _ pt) = Table pt
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
selectAll :: Table a -> STM (TableVarS Set a)
-- ^ This function gives the set of all values in the table.
selectAll (Table pt) =
    do mp <- readTVar $ tabContent pt
       let makeRef ~(n, tv) = Ref {refContent = tv, refIndex = n}
       return $ TableVar (fromAscList $ map makeRef $ toAscList mp) pt