{-# LANGUAGE GADTs #-}
module Data.HMemDb.Tables
    (
     PreTable(tabCount, tabContent, tabConv, tabIndices),
     Table(Table),
     deleteFromTable,
     emptyPreTable,
     foldTable_,
     insertIntoTable,
     insertRefIntoTable,
     modifyInTable
    ) where
import Control.Concurrent.STM (STM, TVar, modifyTVar', newTVar, readTVar, writeTVar)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
import Data.Foldable (for_)
import qualified Data.Map as M (Map, delete, empty, insert)
import Data.HMemDb.Bin (Bin)
import Data.HMemDb.MapTVar (MS, liftMaybe)
import Data.HMemDb.KeyBackends (KeyBack, deleteFromKeys, insertIntoKeys, modifyInKeys)
import Data.HMemDb.RefConverter (PreRefConv(rcFrom, rcTo))
import Data.HMemDb.References (Ref(Ref, refContent, refIndex), deRef)
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]
    }
emptyPreTable :: PreRefConv r a a -> STM (PreTable r a)
emptyPreTable pr =
    do count <- newTVar 0
       content <- newTVar M.empty
       let pt =
               PreTable {
                 tabCount = count,
                 tabConv = pr,
                 tabContent = content,
                 tabIndices = []
               }
       return pt
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
foldTable_ :: (a -> MS b) -> Table a -> STM ()
-- ^ This function traverses through all values in the table, applying the same action
-- to all of them. Errors are silently ignored.
foldTable_ h (Table pt) =
    do mp <- readTVar $ tabContent pt
       for_ mp $ \tv -> runMaybeT $ MaybeT (readTVar tv) >>= rcTo (tabConv pt) >>= h