module Database.Selda.Selectors where
import Database.Selda.Table
import Database.Selda.Types
import Database.Selda.Column
import Data.Dynamic
import Data.List (foldl')
import Unsafe.Coerce
(!) :: forall s t a. ToDyn (Cols () t) => Cols s t -> Selector t a -> Col s a
tup ! (Selector n) = unsafeCoerce (unsafeToList (toU tup) !! n)
where toU = unsafeCoerce :: Cols s t -> Cols () t
upd :: forall s t. (ToDyn (Cols () t))
=> Cols s t -> Assignment s t -> Cols s t
upd tup (Selector n := x) =
fromU . unsafeFromList $ replace (unsafeToList $ toU tup) (unsafeCoerce x)
where
toU = unsafeCoerce :: Cols s t -> Cols () t
fromU = unsafeCoerce :: Cols () t -> Cols s t
replace xs x' =
case splitAt n xs of
(left, _:right) -> left ++ x' : right
_ -> error "impossible"
data Assignment s t where
(:=) :: Selector t a -> Col s a -> Assignment s t
infixl 2 :=
with :: forall s t. (ToDyn (Cols () t))
=> Cols s t -> [Assignment s t] -> Cols s t
with = foldl' upd
data Selector t a = Selector Int
type family Selectors t a where
Selectors t (a :*: b) = (Selector t a :*: Selectors t b)
Selectors t a = Selector t a
selectors :: forall a. HasSelectors a a => Table a -> Selectors a a
selectors _ = mkSel (Proxy :: Proxy a) 0 (Proxy :: Proxy a)
class HasSelectors t a where
mkSel :: Proxy t -> Int -> Proxy a -> Selectors t a
instance (Typeable a, HasSelectors t b) => HasSelectors t (a :*: b) where
mkSel p n _ = (Selector n :*: mkSel p (n+1) (Proxy :: Proxy b))
instance (Selectors t a ~ Selector t a) =>
HasSelectors t a where
mkSel _ n _ = Selector n
tableWithSelectors :: forall a. (TableSpec a, HasSelectors a a)
=> TableName
-> ColSpecs a
-> (Table a, Selectors a a)
tableWithSelectors name cs = (t, s)
where
t = table name cs
s = selectors t