module Data.HMemDb.CreateTable (CreateTable(makeTable), IsKeySpec, createTable) where
import Control.Applicative ((<$>))
import Control.Arrow (first)
import Control.Concurrent.STM (STM, newTVar)
import qualified Data.Map as M (empty)
import Data.HMemDb.Bin (Bin)
import Data.HMemDb.ForeignKeys (ForeignKey(ForeignKey))
import Data.HMemDb.KeyBackends (KeyBack(KeyBack), PreKeyBack(PreKeyBack))
import Data.HMemDb.MapTVar (readTVarMap)
import Data.HMemDb.RefContainer (RefContainer)
import Data.HMemDb.RefConverter (PreRefConv, RefConv(RefConv))
import Data.HMemDb.Specs
(FullSpec(keySpec, tabSpec), Keys(Keys), KeySpec(KeySpec), makeRC, (:+:)((:+:)))
import Data.HMemDb.Tables
(PreTable(tabIndices), Table(Table), emptyPreTable)
class CreateTable u where
makeTable ::
Bin r => PreRefConv r a a -> u a KeySpec -> STM (PreTable r a, u a ForeignKey)
instance CreateTable Keys where
makeTable pr ~Keys =
do pt <- emptyPreTable pr
return (pt, Keys)
class IsKeySpec ks where
makeTableKS ::
(Bin r, CreateTable u) => PreRefConv r a a
-> (u :+: ks) a KeySpec
-> STM (PreTable r a, (u :+: ks) a ForeignKey)
instance (Ord i, RefContainer s) => IsKeySpec (KeySpec s i) where
makeTableKS pr (uk :+: KeySpec h) =
do ~(pt, uf) <- makeTable pr uk
ii <- newTVar M.empty
tv <- newTVar M.empty
let pt' = pt {tabIndices = KeyBack (PreKeyBack h ii tv) : tabIndices pt}
return (pt', uf :+: ForeignKey pt' (readTVarMap tv))
instance (CreateTable u, IsKeySpec ks) => CreateTable (u :+: ks) where
makeTable = makeTableKS
createTable :: CreateTable u => FullSpec a u -> STM (Table a, u a ForeignKey)
createTable fs =
case makeRC $ tabSpec fs of
RefConv _ pr -> first Table <$> makeTable pr (keySpec fs)