{-# LANGUAGE TypeFamilies, GADTs, CPP #-}
module Database.Selda.Selectors
( Assignment ((:=)), Selector, Coalesce
, (!), (?), with, ($=)
, selectorIndex, unsafeSelector
) where
import Database.Selda.SqlRow (SqlRow)
import Database.Selda.SqlType ( SqlType )
import Database.Selda.Column
( UntypedCol(Untyped), Row(..), Col(..) )
import Data.List (foldl')
import Unsafe.Coerce ( unsafeCoerce )
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 :: forall a b. (SqlRow a, SqlType b) => Int -> Selector a b
unsafeSelector = forall t a. Int -> Selector t a
Selector
(!) :: SqlType a => Row s t -> Selector t a -> Col s a
(Many [UntypedCol SQL]
xs) ! :: forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
! (Selector Int
i) = case [UntypedCol SQL]
xs forall a. [a] -> Int -> a
!! Int
i of Untyped Exp SQL a
x -> forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall a b. a -> b
unsafeCoerce Exp SQL a
x)
infixl 9 !
(?) :: SqlType a => Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
(Many [UntypedCol SQL]
xs) ? :: forall a s t.
SqlType a =>
Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
? (Selector Int
i) = case [UntypedCol SQL]
xs forall a. [a] -> Int -> a
!! Int
i of Untyped Exp SQL a
x -> forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall a b. a -> b
unsafeCoerce Exp SQL a
x)
infixl 9 ?
upd :: Row s a -> Assignment s a -> Row s a
upd :: forall s a. Row s a -> Assignment s a -> Row s a
upd (Many [UntypedCol SQL]
xs) (Selector Int
i := (One Exp SQL a
x')) =
case forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [UntypedCol SQL]
xs of
([UntypedCol SQL]
left, UntypedCol SQL
_:[UntypedCol SQL]
right) -> forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many ([UntypedCol SQL]
left forall a. [a] -> [a] -> [a]
++ forall sql a. Exp sql a -> UntypedCol sql
Untyped Exp SQL a
x' forall a. a -> [a] -> [a]
: [UntypedCol SQL]
right)
([UntypedCol SQL], [UntypedCol SQL])
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: too few columns in row!"
upd (Many [UntypedCol SQL]
xs) (Modify (Selector Int
i) Col s a -> Col s a
f) =
case forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [UntypedCol SQL]
xs of
([UntypedCol SQL]
left, Untyped Exp SQL a
x:[UntypedCol SQL]
right) -> forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many ([UntypedCol SQL]
left forall a. [a] -> [a] -> [a]
++ Exp SQL a -> UntypedCol SQL
f' (forall a b. a -> b
unsafeCoerce Exp SQL a
x) forall a. a -> [a] -> [a]
: [UntypedCol SQL]
right)
([UntypedCol SQL], [UntypedCol SQL])
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: too few columns in row!"
where
f' :: Exp SQL a -> UntypedCol SQL
f' Exp SQL a
x = case Col s a -> Col s a
f (forall {k} (s :: k) a. Exp SQL a -> Col s a
One Exp SQL a
x) of
One Exp SQL a
y -> forall sql a. Exp sql a -> UntypedCol sql
Untyped Exp SQL a
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
$= :: forall t a s.
Selector t a -> (Col s a -> Col s a) -> Assignment s t
($=) = forall t a s.
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 :: forall s a. Row s a -> [Assignment s a] -> Row s a
with = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall s a. Row s a -> Assignment s a -> Row s a
upd
newtype Selector t a = Selector {forall t a. Selector t a -> Int
selectorIndex :: Int}