{-# LANGUAGE TypeFamilies, GADTs, CPP #-}
module Database.Selda.Selectors
( Assignment ((:=)), Selector, Coalesce
, (!), (?), with, ($=)
, selectorIndex, unsafeSelector
) where
import Database.Selda.SqlRow (SqlRow)
import Database.Selda.SqlType
import Database.Selda.Column
import Data.List (foldl')
import Unsafe.Coerce
type family Coalesce a where
Coalesce (Maybe (Maybe a)) = Coalesce (Maybe a)
Coalesce a = a
unsafeSelector :: (SqlRow a, SqlType b) => Int -> Selector a b
unsafeSelector = Selector
(!) :: SqlType a => Row s t -> Selector t a -> Col s a
(Many xs) ! (Selector i) = case xs !! i of Untyped x -> One (unsafeCoerce x)
infixl 9 !
(?) :: SqlType a => Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
(Many xs) ? (Selector i) = case xs !! i of Untyped x -> One (unsafeCoerce x)
infixl 9 ?
upd :: Row s a -> Assignment s a -> Row s a
upd (Many xs) (Selector i := (One x')) =
case splitAt i xs of
(left, _:right) -> Many (left ++ Untyped x' : right)
_ -> error "BUG: too few columns in row!"
upd (Many xs) (Modify (Selector i) f) =
case splitAt i xs of
(left, Untyped x:right) -> Many (left ++ f' (unsafeCoerce x) : right)
_ -> error "BUG: too few columns in row!"
where
f' x = case f (One x) of
One y -> Untyped y
data Assignment s a where
(:=) :: Selector t a -> Col s a -> Assignment s t
Modify :: Selector t a -> (Col s a -> Col s a) -> Assignment s t
infixl 2 :=
($=) :: Selector t a -> (Col s a -> Col s a) -> Assignment s t
($=) = Modify
infixl 2 $=
with :: Row s a -> [Assignment s a] -> Row s a
with = foldl' upd
newtype Selector t a = Selector {selectorIndex :: Int}