module Sqel.Query.Combinators where

import Sqel.Class.Mods (MapMod, setMod)
import Sqel.Data.Dd (Dd (Dd), DdK (DdK), Struct (Prim))
import Sqel.Data.FragType (FragType (Limit, Offset, Order, Where))
import Sqel.Data.Order (Order)
import Sqel.Data.Sel (Sel (SelAuto, SelUnused), mkSel)
import Sqel.Data.SelectExpr (SelectAtom (SelectAtom))
import Sqel.Data.Selector (Selector (Selector))
import Sqel.Data.Sql (Sql, sql)
import Sqel.Prim (primMod)
import Sqel.Sql.Prepared (dollar)

whereOp :: Sql -> SelectAtom
whereOp :: Sql -> SelectAtom
whereOp Sql
op =
  FragType -> (Selector -> Int -> Sql) -> SelectAtom
SelectAtom FragType
Where (\ Selector
sel Int
i -> [sql|##{sel} #{op} #{dollar i}|])

whereEq :: SelectAtom
whereEq :: SelectAtom
whereEq =
  Sql -> SelectAtom
whereOp Sql
"="

whereGt :: SelectAtom
whereGt :: SelectAtom
whereGt =
  Sql -> SelectAtom
whereOp Sql
">"

whereGte :: SelectAtom
whereGte :: SelectAtom
whereGte =
  Sql -> SelectAtom
whereOp Sql
">="

whereLt :: SelectAtom
whereLt :: SelectAtom
whereLt =
  Sql -> SelectAtom
whereOp Sql
"<"

whereLte :: SelectAtom
whereLte :: SelectAtom
whereLte =
  Sql -> SelectAtom
whereOp Sql
"<="

whereLike :: SelectAtom
whereLike :: SelectAtom
whereLike =
  Sql -> SelectAtom
whereOp Sql
"like"

greater ::
  MapMod SelectAtom s0 s1 =>
  Dd s0 ->
  Dd s1
greater :: forall (s0 :: DdK) (s1 :: DdK).
MapMod SelectAtom s0 s1 =>
Dd s0 -> Dd s1
greater =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod SelectAtom
whereGt

greaterEq ::
  MapMod SelectAtom s0 s1 =>
  Dd s0 ->
  Dd s1
greaterEq :: forall (s0 :: DdK) (s1 :: DdK).
MapMod SelectAtom s0 s1 =>
Dd s0 -> Dd s1
greaterEq =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod SelectAtom
whereGte

less ::
  MapMod SelectAtom s0 s1 =>
  Dd s0 ->
  Dd s1
less :: forall (s0 :: DdK) (s1 :: DdK).
MapMod SelectAtom s0 s1 =>
Dd s0 -> Dd s1
less =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod SelectAtom
whereLt

lessEq ::
  MapMod SelectAtom s0 s1 =>
  Dd s0 ->
  Dd s1
lessEq :: forall (s0 :: DdK) (s1 :: DdK).
MapMod SelectAtom s0 s1 =>
Dd s0 -> Dd s1
lessEq =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod SelectAtom
whereLte

like ::
  MapMod SelectAtom s0 s1 =>
  Dd s0 ->
  Dd s1
like :: forall (s0 :: DdK) (s1 :: DdK).
MapMod SelectAtom s0 s1 =>
Dd s0 -> Dd s1
like =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod SelectAtom
whereLike

nocond :: Dd ('DdK sel p a s) -> Dd ('DdK 'SelUnused p a s)
nocond :: forall (sel :: Sel) (p :: [*]) a (s :: Struct).
Dd ('DdK sel p a s) -> Dd ('DdK 'SelUnused p a s)
nocond (Dd SelW sel
_ Mods mods
p DdStruct s1
s) =
  forall (sel :: Sel) (mods :: [*]) (s1 :: Struct) a.
SelW sel -> Mods mods -> DdStruct s1 -> Dd ('DdK sel mods a s1)
Dd forall (sel :: Sel). MkSel sel => SelW sel
mkSel Mods mods
p DdStruct s1
s

limit ::
  Dd ('DdK 'SelUnused '[SelectAtom] a 'Prim)
limit :: forall a. Dd ('DdK 'SelUnused '[SelectAtom] a 'Prim)
limit =
  forall (sel :: Sel) (p :: [*]) a (s :: Struct).
Dd ('DdK sel p a s) -> Dd ('DdK 'SelUnused p a s)
nocond (forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod (FragType -> (Selector -> Int -> Sql) -> SelectAtom
SelectAtom FragType
Limit (forall a b. a -> b -> a
const Int -> Sql
dollar)))

offset ::
  Dd ('DdK 'SelUnused '[SelectAtom] a 'Prim)
offset :: forall a. Dd ('DdK 'SelUnused '[SelectAtom] a 'Prim)
offset =
  forall (sel :: Sel) (p :: [*]) a (s :: Struct).
Dd ('DdK sel p a s) -> Dd ('DdK 'SelUnused p a s)
nocond (forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod (FragType -> (Selector -> Int -> Sql) -> SelectAtom
SelectAtom FragType
Offset (forall a b. a -> b -> a
const Int -> Sql
dollar)))

order ::
  Order ->
  Dd ('DdK 'SelAuto '[SelectAtom] a 'Prim)
order :: forall a. Order -> Dd ('DdK 'SelAuto '[SelectAtom] a 'Prim)
order Order
dir =
  forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod (FragType -> (Selector -> Int -> Sql) -> SelectAtom
SelectAtom (Order -> FragType
Order Order
dir) (\ (Selector Sql
sel) Int
_ -> Sql
sel))