{-# LANGUAGE GADTs #-}
module Data.HMemDb.Tables
    (
     PreTable(PreTable, tabCount, tabContent, tabConv, tabIndices),
     Table(Table),
     deleteFromTable,
     insertIntoTable,
     insertRefIntoTable,
     modifyInTable
    ) where
import Control.Concurrent.STM (TVar, modifyTVar', newTVar, readTVar, writeTVar)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (runMaybeT)
import qualified Data.Map as M (Map, delete, insert)
import Data.HMemDb.Bin (Bin)
import Data.HMemDb.Binary (MS)
import Data.HMemDb.KeyBackends (KeyBack, deleteFromKeys, insertIntoKeys, modifyInKeys)
import Data.HMemDb.RefConverter (PreRefConv(rcFrom, rcTo))
import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
import Data.HMemDb.Utils (liftMaybe)
data PreTable r a =
    PreTable
    {
      tabCount :: TVar Integer,
      tabConv :: PreRefConv r a a,
      tabContent :: TVar (M.Map Integer (TVar (Maybe r))),
      tabIndices :: [KeyBack r a]
    }
data Table a where Table :: Bin r => PreTable r a -> Table a
-- ^ This type represent tables. Each table is the set of values.
-- Individual values can be accessed with 'Data.HMemDb.TableVar's
-- or 'Data.HMemDb.ForeignKey's.
-- Tables are never created manually,
-- they should be generated by 'Data.HMemDb.createTable'
-- or loaded by 'Data.HMemDb.getTable'.
-- Both functions require the structure of the table to be described
-- as the 'Data.HMemDb.FullSpec'.
insertTVarIntoTable :: a -> Integer -> TVar (Maybe r) -> PreTable r a -> MS (Ref r)
insertTVarIntoTable a n tv pt =
    do let ref = Ref {refContent = tv, refIndex = n}
       insertIntoKeys a ref $ tabIndices pt
       lift $ modifyTVar' (tabContent pt) $ M.insert n tv
       return ref
insertIntoTable :: a -> PreTable r a -> MS (Ref r)
insertIntoTable a pt =
    do n <- lift $ readTVar $ tabCount pt
       content <- rcFrom (tabConv pt) a >>= lift . newTVar . Just
       ref <- insertTVarIntoTable a n content pt
       lift $ writeTVar (tabCount pt) $ n+1
       return ref
insertRefIntoTable :: PreTable r a -> (Integer, r) -> MS (Ref r)
insertRefIntoTable pt ~(n, r) =
    do tv <- lift $ newTVar $ Just r
       a <- rcTo (tabConv pt) r
       insertTVarIntoTable a n tv pt
deleteFromTable :: Ref r -> PreTable r a -> MS a
deleteFromTable ref pt =
    do a <- lift $ runMaybeT $ deRef ref >>= rcTo (tabConv pt)
       lift $ do
         modifyTVar' (tabContent pt) $ M.delete $ refIndex ref
         deleteFromKeys ref $ tabIndices pt
         writeTVar (refContent ref) Nothing
       liftMaybe a
modifyInTable :: a -> Ref r -> PreTable r a -> MS a
modifyInTable new ref pt = 
    do old <- deRef ref >>= rcTo (tabConv pt)
       r <- rcFrom (tabConv pt) new
       lift $ modifyInKeys new ref $ tabIndices pt
       lift $ writeTVar (refContent ref) $ Just r
       return old