module Data.HMemDb.Specs
(
ColSpec,
FullSpec(FullSpec, keySpec, tabSpec),
Keys(Keys),
KeySpec(KeySpec),
TableSpec,
key,
makeRC,
nonunique,
tref,
val,
unique,
(:+:)((:+:))) where
import Control.Applicative (Applicative(pure, (<*>)), (<$>))
import Control.Compose (Id)
import Data.Binary (Binary)
import Data.Set (Set)
import Data.HMemDb.Bin
(Proxy(Proxy, unProxy), TableGetData(TableGetData), TableRefs(TRProxy, TRVar))
import Data.HMemDb.ForeignKeys (ForeignKey, getCRef, keyTarget)
import Data.HMemDb.RefConverter (PreRefConv(PreRefConv, rcFrom, rcTo), RefConv(RefConv))
import Data.HMemDb.References (cRefIndex, deCRef, readCRef)
import Data.HMemDb.Tables (Table(Table), tabContent, tabConv)
import Data.HMemDb.TableVarId (TableVarId(TableVarId))
data TableSpecPart input col where
TSPVal :: Binary col => (input -> col) -> TableSpecPart input col
TSPKey :: Ord i => (input -> i) -> ForeignKey Id i col -> TableSpecPart input col
TSPRef ::
(input -> TableVarId col) -> Table col -> TableSpecPart input (TableVarId col)
data ColSpec input output where
CSEnd :: output -> ColSpec input output
CSPart ::
TableSpecPart input col -> ColSpec input (col -> output) -> ColSpec input output
instance Functor (ColSpec input) where
fmap h (CSEnd output) = CSEnd $ h output
fmap h (CSPart csp c) = CSPart csp $ (h .) <$> c
instance Applicative (ColSpec input) where
pure = CSEnd
CSEnd h <*> c = h <$> c
CSPart csp c <*> c' = CSPart csp $ flip <$> c <*> c'
val :: Binary col => (input -> col) -> ColSpec input col
val h = CSPart (TSPVal h) (pure id)
key :: Ord i => ForeignKey Id i col -> (input -> i) -> ColSpec input col
key k h = CSPart (TSPKey h k) (pure id)
tref :: Table col -> (input -> TableVarId col) -> ColSpec input (TableVarId col)
tref t h = CSPart (TSPRef h t) (pure id)
type TableSpec a = ColSpec a a
cspToRC :: TableSpecPart input col -> RefConv input col
cspToRC (TSPVal g) =
RefConv TRProxy (PreRefConv {rcFrom = return . Proxy . g, rcTo = return . unProxy})
cspToRC (TSPKey g f) =
case keyTarget f of
Table pt ->
let tgd = TableGetData (rcTo $ tabConv pt) (tabContent pt)
in RefConv (TRVar tgd) (PreRefConv {rcFrom = getCRef f . g, rcTo = deCRef})
cspToRC (TSPRef g (Table pt)) =
let tv = tabContent pt
rto = rcTo $ tabConv pt
from input =
do let TableVarId index = g input
readCRef rto tv index
to = return . TableVarId . cRefIndex
in RefConv (TRVar $ TableGetData rto tv) (PreRefConv {rcFrom = from, rcTo = to})
makeRC :: ColSpec input output -> RefConv input output
makeRC (CSEnd output) = pure output
makeRC (CSPart csp c) = makeRC c <*> cspToRC csp
data KeySpec (s :: * -> *) i a = KeySpec (a -> i)
unique :: (a -> i) -> KeySpec Id i a
unique = KeySpec
nonunique :: (a -> i) -> KeySpec Set i a
nonunique = KeySpec
data Keys a (h :: (* -> *) -> * -> * -> *) = Keys
data (u :+: ks) a h where (:+:) :: u a h -> h s i a -> (u :+: KeySpec s i) a h
infixl 4 :+:
data FullSpec a u = FullSpec {tabSpec :: TableSpec a, keySpec :: u a KeySpec}