{-# 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 )

-- | Coalesce nested nullable column into a single level of nesting.
type family Coalesce a where
  Coalesce (Maybe (Maybe a)) = Coalesce (Maybe a)
  Coalesce a                 = a

-- | A selector indicating the nth (zero-based) column of a table.
--
--   Will cause errors in queries during compilation, execution, or both,
--   unless handled with extreme care. You really shouldn't use it at all.
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

-- | Extract the given column from the given row.
(!) :: 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 !

-- | Extract the given column from the given nullable row.
--   Nullable rows usually result from left joins.
--   If a nullable column is extracted from a nullable row, the resulting
--   nested @Maybe@s will be squashed into a single level of nesting.
(?) :: 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

-- | A selector-value assignment pair.
data Assignment s a where
  -- | Set the given column to the given value.
  (:=) :: Selector t a -> Col s a -> Assignment s t

  -- | Modify the given column by the given function.
  Modify :: Selector t a -> (Col s a -> Col s a) -> Assignment s t
infixl 2 :=

-- | Apply the given function to the given column.
($=) :: 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 $=

-- | For each selector-value pair in the given list, on the given tuple,
--   update the field pointed out by the selector with the corresponding value.
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

-- | A column selector. Column selectors can be used together with the '!' and
--   'with' functions to get and set values on rows, or to specify
--   foreign keys.
newtype Selector t a = Selector {forall t a. Selector t a -> Int
selectorIndex :: Int}