module Data.HMemDb.TableVarId (TableVarId, idToVar, tableIds, tvIdTarget, varToId) where
import Control.Compose (Id(Id), unId)
import Control.Concurrent.STM (readTVar)
import Control.Monad.Trans.Class (lift)
import Data.Function (on)
import qualified Data.Map as M (lookup)
import Data.HMemDb.Binary (MS)
import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))
import Data.HMemDb.References (Ref(Ref, refContent, refIndex))
import Data.HMemDb.Tables (Table(Table), tabContent)
import Data.HMemDb.TableVars (TableVar, TableVarS(TableVar))
import Data.HMemDb.Utils (liftMaybe)
data TableVarId a =
TableVarId
{
unTVId :: Integer,
tvIdTarget :: Table a
}
instance Eq (TableVarId a) where (==) = (==) `on` unTVId
instance Ord (TableVarId a) where compare = compare `on` unTVId
varToId :: TableVar a -> TableVarId a
varToId (TableVar iref pt) =
TableVarId {unTVId = refIndex (unId iref), tvIdTarget = Table pt}
idToVar :: TableVarId a -> MS (TableVar a)
idToVar tvId =
case tvIdTarget tvId of
Table pt ->
do mp <- lift $ readTVar $ tabContent pt
let i = unTVId tvId
tv <- liftMaybe $ M.lookup i mp
return $ TableVar (Id Ref {refContent = tv, refIndex = i}) pt
tableIds :: Table a -> ForeignKey Id (TableVarId a) a
tableIds (Table pt) =
ForeignKey pt $ \tvId -> do
mp <- lift (readTVar $ tabContent pt)
let i = unTVId tvId
tv <- liftMaybe $ M.lookup i mp
return $ Id Ref {refContent = tv, refIndex = i}