module Data.HMemDb.TableVarId (TableVarId(TableVarId), idToVar, varToId) where
import Control.Compose (Id(Id), unId)
import Data.Function (on)
import Data.HMemDb.MapTVar (MS, readTVarMap)
import Data.HMemDb.References (Ref(Ref, refContent, refIndex))
import Data.HMemDb.Tables (Table(Table), tabContent)
import Data.HMemDb.TableVars (TableVar, TableVarS(TableVar))
newtype TableVarId a = TableVarId {unTVId :: Integer}
-- ^ This type can be used for columns in a table.
-- It's sort of a 'ForeignKey' accompanied with a specific index.
instance Eq (TableVarId a) where (==) = (==) `on` unTVId
-- ^ 'TableVarId's pointing to different 'Table's may accidentally appear equal.
instance Ord (TableVarId a) where compare = compare `on` unTVId
varToId :: TableVar a -> TableVarId a
-- ^ This function gets an Id of the variable.
varToId (TableVar _ iref _) = TableVarId $ refIndex $ unId iref
idToVar :: Table a -> TableVarId a -> MS (TableVar a)
-- ^ This function looks up the specific Id in the 'Table'.
idToVar (Table b pt) tvId =
    do let i = unTVId tvId
       tv <- readTVarMap (tabContent pt) i
       return $ TableVar b (Id Ref {refContent = tv, refIndex = i}) pt