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.RefContainer (RefContainer)
import Data.HMemDb.RefConverter (PreRefConv, RefConv(RefConv))
import Data.HMemDb.Specs
(FullSpec(FullSpec, keySpec, tabSpec),
Keys(Keys), KeySpec(KeySpec), TableSpec(TableSpec),
makeRC, (:+:)((:+:)))
import Data.HMemDb.Tables
(PreTable(PreTable, tabContent, tabConv, tabCount, tabIndices), Table(Table))
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 count <- newTVar 0
content <- newTVar M.empty
let pt =
PreTable
{tabCount = count, tabConv = pr, tabContent = content, tabIndices = []}
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' 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 (FullSpec {tabSpec = TableSpec cs, keySpec = ks}) =
case makeRC cs of RefConv _ pr -> first Table <$> makeTable pr ks