module Data.HMemDb.Persistence (getTable, putTable) where
import Control.Applicative (Applicative(pure, (<*>)), (<$>))
import Control.Compose (oPure)
import Control.Concurrent.STM (STM, TVar, readTVar, writeTVar)
import Control.Monad.Trans.Cont (Cont, runCont, cont)
import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
import Data.Binary (Binary(get, put))
import Data.Foldable (for_)
import qualified Data.Map as M (toAscList)
import Data.HMemDb.Bin (Bin (binGet, binPut))
import Data.HMemDb.Binary (GS, SP)
import Data.HMemDb.CreateTable (CreateTable(makeTable))
import Data.HMemDb.ForeignKeys (ForeignKey)
import Data.HMemDb.RefConverter (RefConv(RefConv))
import Data.HMemDb.Specs
    (FullSpec(FullSpec, keySpec, tabSpec), TableSpec(TableSpec), makeRC)
import Data.HMemDb.Tables
    (PreTable(tabContent, tabCount), Table(Table), insertRefIntoTable)
import Data.HMemDb.Utils
    (bindO, enumElem, fixArray, oBind, liftPure, pureO, replicateO)
-- serialization
putTVar :: TVar a -> Cont SP a
putTVar tv = cont $ bindO $ readTVar tv
readValue :: (a, TVar (Maybe b)) -> STM (Maybe (a, b))
readValue (n, tv) = fmap ((,) n) <$> readTVar tv
putPreTable :: Bin r => PreTable r a -> Cont SP ()
putPreTable pt =
    do tC <- putTVar $ tabCount pt
       liftPure $ put tC
       mp <- putTVar $ tabContent pt
       pairs <- fixArray (M.toAscList mp) readValue
       liftPure $ put $ length pairs
       ~(n, r) <- enumElem pairs
       liftPure $ put n >> binPut r
putTable :: Table a -> SP
-- ^ This function saves the table to the ByteString.
-- Note that it doesn't really matter if the type of values in the table
-- are serializable.
--
-- NB: if any index used to access the values in this table depended on any foreign keys,
-- and targets of these keys have changed,
-- the index could be different after storing and restoring the table.
putTable (Table pt) = runCont (putPreTable pt) pure
-- deserialization
getTable :: CreateTable u => FullSpec a u -> GS (Table a, u a ForeignKey)
-- ^ This function reads the table from the ByteString.
-- As the table structure is NOT stored,
-- one should provide the same one that was used to create this table
getTable (FullSpec {tabSpec = TableSpec cs, keySpec = ks}) =
    case makeRC cs of
      RefConv tr pr ->
          let genPairs =
                  (\result tC pairs -> (result, (tC, pairs)))
                  <$> oPure (makeTable pr ks)
                  <*> pureO get
                  <*> (get `bindO` replicateO ((,) <$> pureO get <*> binGet tr))
              insPairs ~((pt, uf), (tC, pairs)) =
                  do writeTVar (tabCount pt) tC
                     for_ pairs (runMaybeT . insertRefIntoTable pt)
                     return (Table pt, uf)
          in genPairs `oBind` insPairs