{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DataKinds #-}

-- We can probably disable ConstraintKinds and TypeSynonymInstances
-- when we move to Sql... instead of PG..

module Opaleye.Operators
  (
  -- * Restriction operators
    where_
  , restrict
  , restrictExists
  , restrictNotExists
  -- * Numerical operators
  -- | Numeric 'Column' / 'F.Field' types are instances of 'Num'
  -- and 'Fractional', so you can use the standard Haskell numerical
  -- operators (e.g.. '*', '/', '+', '-') on them and you can create
  -- them with numerical literals such as @3.14 :: 'F.Field' 'T.SqlFloat8'@.
  , (+)
  , (-)
  , (*)
  , (/)
  , fromInteger
  , abs
  , negate
  , signum
  -- * Equality operators
  , (.==)
  , (./=)
  , (.===)
  , (./==)
  -- * Comparison operators
  , (.>)
  , (.<)
  , (.<=)
  , (.>=)
  -- * Numerical operators
  , quot_
  , rem_
  -- * Conditional operators
  , case_
  , ifThenElse
  , ifThenElseMany
  -- * Logical operators
  , (.||)
  , (.&&)
  , not
  , ors
  -- * Text operators
  , (.++)
  , lower
  , upper
  , like
  , ilike
  , sqlLength
  -- * Containment operators
  , in_
  , inSelect
  -- * JSON operators
  , SqlIsJson
  , SqlJsonIndex
  , PGJsonIndex
  , (.->)
  , (.->>)
  , (.#>)
  , (.#>>)
  , (.@>)
  , (.<@)
  , (.?)
  , (.?|)
  , (.?&)
  , JBOF.jsonBuildObject
  , JBOF.jsonBuildObjectField
  , JBOF.JSONBuildObjectFields
  -- * SqlArray operators
  , emptyArray
  , arrayAppend
  , arrayPrepend
  , arrayRemove
  , arrayRemoveNulls
  , singletonArray
  , index
  , arrayPosition
  , sqlElem
  -- * Range operators
  , overlap
  , liesWithin
  , upperBound
  , lowerBound
  , (.<<)
  , (.>>)
  , (.&<)
  , (.&>)
  , (.-|-)
  -- * Other operators
  , timestamptzAtTimeZone
  , dateOfTimestamp
  , now
  , IntervalNum
  , addInterval
  , minusInterval
  , TimestampPrecision(..)
  , dateTruncTimestamp
  , dateTruncTimestamptz
  -- * Deprecated
  )

  where

import qualified Control.Arrow as A
import qualified Data.Foldable as F hiding (null)
import qualified Data.List.NonEmpty as NEL
import           Prelude hiding (not)
import qualified Opaleye.Exists as E
import qualified Opaleye.Field as F
import           Opaleye.Internal.Column (Field_(Column), Field, FieldNullable,
                                          Nullability(Nullable),
                                          unsafeCase_,
                                          unsafeIfThenElse, unsafeGt)
import qualified Opaleye.Internal.Column as C
import qualified Opaleye.Internal.JSONBuildObjectFields as JBOF
import           Opaleye.Internal.QueryArr (SelectArr(QueryArr),
                                            runSimpleQueryArr')
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.Operators as O
import           Opaleye.Internal.Helpers   ((.:))
import qualified Opaleye.Lateral as L
import qualified Opaleye.Order as Ord
import qualified Opaleye.Select   as S
import qualified Opaleye.SqlTypes as T

import qualified Opaleye.Column   as Column

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

import qualified Data.Profunctor.Product.Default as D

import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE

{-| Keep only the rows of a query satisfying a given condition, using an
SQL @WHERE@ clause.  It is equivalent to the Haskell function

@
where_ :: Bool -> [()]
where_ True  = [()]
where_ False = []
@
-}
where_ :: F.Field T.SqlBool -> S.Select ()
where_ :: Field SqlBool -> Select ()
where_ = SelectArr (Field SqlBool) () -> Field SqlBool -> Select ()
forall i a. SelectArr i a -> i -> Select a
L.viaLateral SelectArr (Field SqlBool) ()
restrict

{-| You would typically use 'restrict' if you want to write your query
using 'A.Arrow' notation.  If you want to use monadic style
then 'where_' will suit you better. -}
restrict :: S.SelectArr (F.Field T.SqlBool) ()
restrict :: SelectArr (Field SqlBool) ()
restrict = SelectArr (Field SqlBool) ()
O.restrict

{-| Add a @WHERE EXISTS@ clause to the current query. -}
restrictExists :: S.SelectArr a b -> S.SelectArr a ()
restrictExists :: forall a b. SelectArr a b -> SelectArr a ()
restrictExists SelectArr a b
criteria = (a -> State Tag ((), PrimQueryArr)) -> SelectArr a ()
forall a b. (a -> State Tag (b, PrimQueryArr)) -> SelectArr a b
QueryArr a -> State Tag ((), PrimQueryArr)
f where
  -- A where exists clause can always refer to columns defined by the
  -- query it references so needs no special treatment on LATERAL.
  f :: a -> State Tag ((), PrimQueryArr)
f a
a = do
    (b
_, PrimQuery
existsQ) <- SelectArr a b -> a -> State Tag (b, PrimQuery)
forall a b. QueryArr a b -> a -> State Tag (b, PrimQuery)
runSimpleQueryArr' SelectArr a b
criteria a
a
    ((), PrimQueryArr) -> State Tag ((), PrimQueryArr)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), SemijoinType -> PrimQuery -> PrimQueryArr
PQ.aSemijoin SemijoinType
PQ.Semi PrimQuery
existsQ)

{-| Add a @WHERE NOT EXISTS@ clause to the current query. -}
restrictNotExists :: S.SelectArr a b -> S.SelectArr a ()
restrictNotExists :: forall a b. SelectArr a b -> SelectArr a ()
restrictNotExists SelectArr a b
criteria = (a -> State Tag ((), PrimQueryArr)) -> SelectArr a ()
forall a b. (a -> State Tag (b, PrimQueryArr)) -> SelectArr a b
QueryArr a -> State Tag ((), PrimQueryArr)
f where
  -- A where exists clause can always refer to columns defined by the
  -- query it references so needs no special treatment on LATERAL.
  f :: a -> State Tag ((), PrimQueryArr)
f a
a = do
    (b
_, PrimQuery
existsQ) <- SelectArr a b -> a -> State Tag (b, PrimQuery)
forall a b. QueryArr a b -> a -> State Tag (b, PrimQuery)
runSimpleQueryArr' SelectArr a b
criteria a
a
    ((), PrimQueryArr) -> State Tag ((), PrimQueryArr)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), SemijoinType -> PrimQuery -> PrimQueryArr
PQ.aSemijoin SemijoinType
PQ.Anti PrimQuery
existsQ)

infix 4 .==
(.==) :: Field a -> Field a -> F.Field T.SqlBool
.== :: forall a. Field a -> Field a -> Field SqlBool
(.==) = BinOp
-> Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:==)

infix 4 ./=
(./=) :: Field a -> Field a -> F.Field T.SqlBool
./= :: forall a. Field a -> Field a -> Field SqlBool
(./=) = BinOp
-> Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<>)

infix 4 .===
-- | A polymorphic equality operator that works for all types that you
-- have run `makeAdaptorAndInstance` on.  This may be unified with
-- `.==` in a future version.
(.===) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool
.=== :: forall fields.
Default EqPP fields fields =>
fields -> fields -> Field SqlBool
(.===) = fields -> fields -> Field SqlBool
forall fields.
Default EqPP fields fields =>
fields -> fields -> Field SqlBool
(O..==)

infix 4 ./==
-- | A polymorphic inequality operator that works for all types that
-- you have run `makeAdaptorAndInstance` on.  This may be unified with
-- `./=` in a future version.
(./==) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool
./== :: forall fields.
Default EqPP fields fields =>
fields -> fields -> Field SqlBool
(./==) = Field SqlBool -> Field SqlBool
Opaleye.Operators.not (Field SqlBool -> Field SqlBool)
-> (fields -> fields -> Field SqlBool)
-> fields
-> fields
-> Field SqlBool
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: fields -> fields -> Field SqlBool
forall fields.
Default EqPP fields fields =>
fields -> fields -> Field SqlBool
(O..==)

infix 4 .>
(.>) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool
.> :: forall a. SqlOrd a => Field a -> Field a -> Field SqlBool
(.>) = Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) pgBool.
Field_ n a -> Field_ n a -> Field_ n' pgBool
unsafeGt

infix 4 .<
(.<) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool
.< :: forall a. SqlOrd a => Field a -> Field a -> Field SqlBool
(.<) = BinOp
-> Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<)

infix 4 .<=
(.<=) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool
.<= :: forall a. SqlOrd a => Field a -> Field a -> Field SqlBool
(.<=) = BinOp
-> Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<=)

infix 4 .>=
(.>=) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool
.>= :: forall a. SqlOrd a => Field a -> Field a -> Field SqlBool
(.>=) = BinOp
-> Field_ 'NonNullable a -> Field_ 'NonNullable a -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:>=)

-- | Integral division, named after 'Prelude.quot'.  It maps to the
-- @/@ operator in Postgres.
quot_ :: C.SqlIntegral a => Field a -> Field a -> Field a
quot_ :: forall a. SqlIntegral a => Field a -> Field a -> Field a
quot_ = BinOp
-> Field_ 'NonNullable a
-> Field_ 'NonNullable a
-> Field_ 'NonNullable a
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:/)

-- | The remainder of integral division, named after 'Prelude.rem'.
-- It maps to 'MOD' ('%') in Postgres, confusingly described as
-- "modulo (remainder)".
rem_ :: C.SqlIntegral a => Field a -> Field a -> Field a
rem_ :: forall a. SqlIntegral a => Field a -> Field a -> Field a
rem_ = BinOp
-> Field_ 'NonNullable a
-> Field_ 'NonNullable a
-> Field_ 'NonNullable a
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
HPQ.OpMod

-- | Select the first case for which the condition is true.
case_ :: [(F.Field T.SqlBool, Field_ n a)] -> Field_ n a -> Field_ n a
case_ :: forall (n :: Nullability) a.
[(Field SqlBool, Field_ n a)] -> Field_ n a -> Field_ n a
case_ = [(Field SqlBool, Field_ n a)] -> Field_ n a -> Field_ n a
forall (n :: Nullability) pgBool (n' :: Nullability) a.
[(Field_ n pgBool, Field_ n' a)] -> Field_ n' a -> Field_ n' a
unsafeCase_

-- | Monomorphic if\/then\/else.
--
-- This may be replaced by 'ifThenElseMany' in a future version.
ifThenElse :: F.Field T.SqlBool -> Field_ n a -> Field_ n a -> Field_ n a
ifThenElse :: forall (n :: Nullability) a.
Field SqlBool -> Field_ n a -> Field_ n a -> Field_ n a
ifThenElse = Field SqlBool -> Field_ n a -> Field_ n a -> Field_ n a
forall (n' :: Nullability) pgBool (n :: Nullability) a.
Field_ n' pgBool -> Field_ n a -> Field_ n a -> Field_ n a
unsafeIfThenElse

-- | Polymorphic if\/then\/else.
ifThenElseMany :: D.Default O.IfPP fields fields
               => F.Field T.SqlBool
               -> fields
               -> fields
               -> fields
ifThenElseMany :: forall fields.
Default IfPP fields fields =>
Field SqlBool -> fields -> fields -> fields
ifThenElseMany = IfPP fields fields -> Field SqlBool -> fields -> fields -> fields
forall columns columns'.
IfPP columns columns'
-> Field SqlBool -> columns -> columns -> columns'
O.ifExplict IfPP fields fields
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

infixr 2 .||

-- | Boolean or
(.||) :: F.Field T.SqlBool -> F.Field T.SqlBool -> F.Field T.SqlBool
.|| :: Field SqlBool -> Field SqlBool -> Field SqlBool
(.||) = Field SqlBool -> Field SqlBool -> Field SqlBool
(O..||)

infixr 3 .&&

-- | Boolean and
(.&&) :: F.Field T.SqlBool -> F.Field T.SqlBool -> F.Field T.SqlBool
.&& :: Field SqlBool -> Field SqlBool -> Field SqlBool
(.&&) = Field SqlBool -> Field SqlBool -> Field SqlBool
(O..&&)

-- | Boolean not
not :: F.Field T.SqlBool -> F.Field T.SqlBool
not :: Field SqlBool -> Field SqlBool
not = Field SqlBool -> Field SqlBool
O.not

-- | True when any element of the container is true
ors :: F.Foldable f => f (F.Field T.SqlBool) -> F.Field T.SqlBool
ors :: forall (f :: * -> *).
Foldable f =>
f (Field SqlBool) -> Field SqlBool
ors = (Field SqlBool -> Field SqlBool -> Field SqlBool)
-> Field SqlBool -> f (Field SqlBool) -> Field SqlBool
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Field SqlBool -> Field SqlBool -> Field SqlBool
(.||) (Bool -> Field SqlBool
T.sqlBool Bool
False)

-- | Concatenate 'F.Field' 'T.SqlText'
(.++) :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlText
.++ :: Field SqlText -> Field SqlText -> Field SqlText
(.++) = BinOp -> Field SqlText -> Field SqlText -> Field SqlText
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:||)

-- | To lowercase
lower :: F.Field T.SqlText -> F.Field T.SqlText
lower :: Field SqlText -> Field SqlText
lower = UnOp -> Field SqlText -> Field SqlText
forall (n :: Nullability) a (n' :: Nullability) b.
UnOp -> Field_ n a -> Field_ n' b
C.unOp UnOp
HPQ.OpLower

-- | To uppercase
upper :: F.Field T.SqlText -> F.Field T.SqlText
upper :: Field SqlText -> Field SqlText
upper = UnOp -> Field SqlText -> Field SqlText
forall (n :: Nullability) a (n' :: Nullability) b.
UnOp -> Field_ n a -> Field_ n' b
C.unOp UnOp
HPQ.OpUpper

-- | Postgres @LIKE@ operator
like :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlBool
like :: Field SqlText -> Field SqlText -> Field SqlBool
like = BinOp -> Field SqlText -> Field SqlText -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
HPQ.OpLike

-- | Postgres @ILIKE@ operator
ilike :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlBool
ilike :: Field SqlText -> Field SqlText -> Field SqlBool
ilike = BinOp -> Field SqlText -> Field SqlText -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
HPQ.OpILike

sqlLength :: C.SqlString a => F.Field a -> F.Field T.SqlInt4
sqlLength :: forall a. SqlString a => Field a -> Field SqlInt4
sqlLength  (Column PrimExpr
e) = PrimExpr -> Field SqlInt4
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"length" [PrimExpr
e])

-- | 'in_' is designed to be used in prefix form.
--
-- 'in_' @validProducts@ @product@ checks whether @product@ is a valid
-- product.  'in_' @validProducts@ is a function which checks whether
-- a product is a valid product.
in_ :: (Functor f, F.Foldable f) => f (Field a) -> Field a -> F.Field T.SqlBool
in_ :: forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Field a) -> Field a -> Field SqlBool
in_ f (Field a)
fcas (Column PrimExpr
a) = case [Field a] -> Maybe (NonEmpty (Field a))
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty (f (Field a) -> [Field a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f (Field a)
fcas) of
   Maybe (NonEmpty (Field a))
Nothing -> Bool -> Field SqlBool
T.sqlBool Bool
False
   Just NonEmpty (Field a)
xs -> PrimExpr -> Field SqlBool
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field SqlBool) -> PrimExpr -> Field SqlBool
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExpr -> PrimExpr -> PrimExpr
HPQ.BinExpr BinOp
HPQ.OpIn PrimExpr
a (NonEmpty PrimExpr -> PrimExpr
HPQ.ListExpr ((Field a -> PrimExpr) -> NonEmpty (Field a) -> NonEmpty PrimExpr
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field a -> PrimExpr
forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn NonEmpty (Field a)
xs))

-- | True if the first argument occurs amongst the rows of the second,
-- false otherwise.
--
-- This operation is equivalent to Postgres's @IN@ operator.
inSelect :: D.Default O.EqPP fields fields
         => fields -> S.Select fields -> S.Select (F.Field T.SqlBool)
inSelect :: forall fields.
Default EqPP fields fields =>
fields -> Select fields -> Select (Field SqlBool)
inSelect fields
c Select fields
q = Select fields -> Select (Field SqlBool)
forall a. Select a -> Select (Field SqlBool)
E.exists (Select fields -> Select (Field SqlBool))
-> Select fields -> Select (Field SqlBool)
forall a b. (a -> b) -> a -> b
$ proc () -> do
  fields
r <- Select fields
q -< ()
  SelectArr (Field SqlBool) ()
restrict -< fields
c fields -> fields -> Field SqlBool
forall fields.
Default EqPP fields fields =>
fields -> fields -> Field SqlBool
.=== fields
r
  SelectArr fields fields
forall (a :: * -> * -> *) b. Arrow a => a b b
A.returnA -< fields
r

-- | Class of Postgres types that represent json values.
-- Used to overload functions and operators that work on both 'T.SqlJson' and 'T.SqlJsonb'.
--
-- Warning: making additional instances of this class can lead to broken code!
class SqlIsJson json

instance SqlIsJson T.SqlJson
instance SqlIsJson T.SqlJsonb

-- | Class of Postgres types that can be used to index json values.
--
-- Warning: making additional instances of this class can lead to broken code!
class SqlJsonIndex a

-- | Use 'SqlJsonIndex' instead. Will be deprecated in a future version.
type PGJsonIndex = SqlJsonIndex

instance SqlJsonIndex T.SqlInt4
instance SqlJsonIndex T.SqlInt8
instance SqlJsonIndex T.SqlText

-- | Get JSON object field by key.
infixl 8 .->
(.->) :: (SqlIsJson json, SqlJsonIndex k)
      => F.FieldNullable json -- ^
      -> F.Field k -- ^ key or index
      -> F.FieldNullable json
.-> :: forall json k.
(SqlIsJson json, SqlJsonIndex k) =>
FieldNullable json -> Field k -> FieldNullable json
(.->) = BinOp
-> Field_ 'Nullable json
-> Field_ 'NonNullable k
-> Field_ 'Nullable json
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:->)

-- | Get JSON object field as text.
infixl 8 .->>
(.->>) :: (SqlIsJson json, SqlJsonIndex k)
       => F.FieldNullable json -- ^
       -> F.Field k -- ^ key or index
       -> F.FieldNullable T.SqlText
.->> :: forall json k.
(SqlIsJson json, SqlJsonIndex k) =>
FieldNullable json -> Field k -> FieldNullable SqlText
(.->>) = BinOp
-> Field_ 'Nullable json
-> Field_ 'NonNullable k
-> FieldNullable SqlText
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:->>)

-- | Get JSON object at specified path.
infixl 8 .#>
(.#>) :: (SqlIsJson json)
      => F.FieldNullable json -- ^
      -> Field (T.SqlArray T.SqlText) -- ^ path
      -> F.FieldNullable json
.#> :: forall json.
SqlIsJson json =>
FieldNullable json
-> Field (SqlArray SqlText) -> FieldNullable json
(.#>) = BinOp
-> Field_ 'Nullable json
-> Field (SqlArray SqlText)
-> Field_ 'Nullable json
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:#>)

-- | Get JSON object at specified path as text.
infixl 8 .#>>
(.#>>) :: (SqlIsJson json)
       => F.FieldNullable json -- ^
       -> Field (T.SqlArray T.SqlText) -- ^ path
       -> F.FieldNullable T.SqlText
.#>> :: forall json.
SqlIsJson json =>
FieldNullable json
-> Field (SqlArray SqlText) -> FieldNullable SqlText
(.#>>) = BinOp
-> Field_ 'Nullable json
-> Field (SqlArray SqlText)
-> FieldNullable SqlText
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:#>>)

-- | Does the left JSON value contain within it the right value?
infix 4 .@>
(.@>) :: F.Field T.SqlJsonb -> F.Field T.SqlJsonb -> F.Field T.SqlBool
.@> :: Field SqlJsonb -> Field SqlJsonb -> Field SqlBool
(.@>) = BinOp -> Field SqlJsonb -> Field SqlJsonb -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:@>)

-- | Is the left JSON value contained within the right value?
infix 4 .<@
(.<@) :: F.Field T.SqlJsonb -> F.Field T.SqlJsonb -> F.Field T.SqlBool
.<@ :: Field SqlJsonb -> Field SqlJsonb -> Field SqlBool
(.<@) = BinOp -> Field SqlJsonb -> Field SqlJsonb -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<@)

-- | Does the key/element string exist within the JSON value?
infix 4 .?
(.?) :: F.Field T.SqlJsonb -> F.Field T.SqlText -> F.Field T.SqlBool
.? :: Field SqlJsonb -> Field SqlText -> Field SqlBool
(.?) = BinOp -> Field SqlJsonb -> Field SqlText -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:?)

-- | Do any of these key/element strings exist?
infix 4 .?|
(.?|) :: F.Field T.SqlJsonb
      -> Field (T.SqlArray T.SqlText)
      -> F.Field T.SqlBool
.?| :: Field SqlJsonb -> Field (SqlArray SqlText) -> Field SqlBool
(.?|) = BinOp
-> Field SqlJsonb -> Field (SqlArray SqlText) -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:?|)

-- | Do all of these key/element strings exist?
infix 4 .?&
(.?&) :: F.Field T.SqlJsonb
      -> Field (T.SqlArray T.SqlText)
      -> F.Field T.SqlBool
.?& :: Field SqlJsonb -> Field (SqlArray SqlText) -> Field SqlBool
(.?&) = BinOp
-> Field SqlJsonb -> Field (SqlArray SqlText) -> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:?&)

emptyArray :: T.IsSqlType a => Field (T.SqlArray_ n a)
emptyArray :: forall a (n :: Nullability). IsSqlType a => Field (SqlArray_ n a)
emptyArray = (Field_ n a -> Field_ n a) -> [Field_ n a] -> Field (SqlArray_ n a)
forall b a (n :: Nullability).
IsSqlType b =>
(a -> Field_ n b) -> [a] -> Field (SqlArray_ n b)
T.sqlArray Field_ n a -> Field_ n a
forall a. a -> a
id []

-- | Append two 'T.SqlArray's
arrayAppend :: F.Field (T.SqlArray_ n a) -> F.Field (T.SqlArray_ n a) -> F.Field (T.SqlArray_ n a)
arrayAppend :: forall (n :: Nullability) a.
Field (SqlArray_ n a)
-> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
arrayAppend = BinOp
-> Field_ 'NonNullable (SqlArray_ n a)
-> Field_ 'NonNullable (SqlArray_ n a)
-> Field_ 'NonNullable (SqlArray_ n a)
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:||)

-- | Prepend an element to a 'T.SqlArray'
arrayPrepend :: Field_ n a -> Field (T.SqlArray_ n a) -> Field (T.SqlArray_ n a)
arrayPrepend :: forall (n :: Nullability) a.
Field_ n a -> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
arrayPrepend (Column PrimExpr
e) (Column PrimExpr
es) = PrimExpr -> Field_ 'NonNullable (SqlArray_ n a)
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"array_prepend" [PrimExpr
e, PrimExpr
es])

-- | Remove all instances of an element from a 'T.SqlArray'
arrayRemove :: Field_ n a -> Field (T.SqlArray_ n a) -> Field (T.SqlArray_ n a)
arrayRemove :: forall (n :: Nullability) a.
Field_ n a -> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
arrayRemove (Column PrimExpr
e) (Column PrimExpr
es) = PrimExpr -> Field_ 'NonNullable (SqlArray_ n a)
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"array_remove" [PrimExpr
es, PrimExpr
e])

-- | Remove all 'NULL' values from a 'T.SqlArray'
arrayRemoveNulls :: Field (T.SqlArray_ Nullable a) -> Field (T.SqlArray a)
arrayRemoveNulls :: forall a. Field (SqlArray_ 'Nullable a) -> Field (SqlArray a)
arrayRemoveNulls = Field_ 'NonNullable (SqlArray_ 'Nullable a)
-> Field_ 'NonNullable (SqlArray a)
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
Column.unsafeCoerceColumn (Field_ 'NonNullable (SqlArray_ 'Nullable a)
 -> Field_ 'NonNullable (SqlArray a))
-> (Field_ 'NonNullable (SqlArray_ 'Nullable a)
    -> Field_ 'NonNullable (SqlArray_ 'Nullable a))
-> Field_ 'NonNullable (SqlArray_ 'Nullable a)
-> Field_ 'NonNullable (SqlArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ 'Nullable a
-> Field_ 'NonNullable (SqlArray_ 'Nullable a)
-> Field_ 'NonNullable (SqlArray_ 'Nullable a)
forall (n :: Nullability) a.
Field_ n a -> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
arrayRemove Field_ 'Nullable a
forall a. FieldNullable a
F.null

singletonArray :: T.IsSqlType a => Field_ n a -> Field (T.SqlArray_ n a)
singletonArray :: forall a (n :: Nullability).
IsSqlType a =>
Field_ n a -> Field (SqlArray_ n a)
singletonArray Field_ n a
x = Field_ n a -> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
forall (n :: Nullability) a.
Field_ n a -> Field (SqlArray_ n a) -> Field (SqlArray_ n a)
arrayPrepend Field_ n a
x Field (SqlArray_ n a)
forall a (n :: Nullability). IsSqlType a => Field (SqlArray_ n a)
emptyArray

index :: (C.SqlIntegral n) => Field (T.SqlArray_ n' a) -> Field n -> FieldNullable a
index :: forall n (n' :: Nullability) a.
SqlIntegral n =>
Field (SqlArray_ n' a) -> Field n -> FieldNullable a
index (Column PrimExpr
a) (Column PrimExpr
b) = PrimExpr -> Field_ 'Nullable a
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> PrimExpr -> PrimExpr
HPQ.ArrayIndex PrimExpr
a PrimExpr
b)

-- | Postgres's @array_position@
arrayPosition :: F.Field (T.SqlArray_ n a) -- ^ Haystack
              -> F.Field_ n a -- ^ Needle
              -> F.FieldNullable T.SqlInt4
arrayPosition :: forall (n :: Nullability) a.
Field (SqlArray_ n a) -> Field_ n a -> FieldNullable SqlInt4
arrayPosition (Column PrimExpr
fs) (Column PrimExpr
f') =
  PrimExpr -> FieldNullable SqlInt4
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column (Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"array_position" [PrimExpr
fs , PrimExpr
f'])

-- | Whether the element (needle) exists in the array (haystack).
-- N.B. this is implemented hackily using @array_position@.  If you
-- need it to be implemented using @= any@ then please open an issue.
sqlElem :: F.Field_ n a -- ^ Needle
        -> F.Field (T.SqlArray_ n a) -- ^ Haystack
        -> F.Field T.SqlBool
sqlElem :: forall (n :: Nullability) a.
Field_ n a -> Field (SqlArray_ n a) -> Field SqlBool
sqlElem Field_ n a
f Field (SqlArray_ n a)
fs = (Field SqlBool -> Field SqlBool
O.not (Field SqlBool -> Field SqlBool)
-> (Field_ n a -> Field SqlBool) -> Field_ n a -> Field SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNullable SqlInt4 -> Field SqlBool
forall a. FieldNullable a -> Field SqlBool
F.isNull (FieldNullable SqlInt4 -> Field SqlBool)
-> (Field_ n a -> FieldNullable SqlInt4)
-> Field_ n a
-> Field SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field (SqlArray_ n a) -> Field_ n a -> FieldNullable SqlInt4
forall (n :: Nullability) a.
Field (SqlArray_ n a) -> Field_ n a -> FieldNullable SqlInt4
arrayPosition Field (SqlArray_ n a)
fs) Field_ n a
f

overlap :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
overlap :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
overlap = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:&&)

liesWithin :: T.IsRangeType a => Field a -> Field (T.SqlRange a) -> F.Field T.SqlBool
liesWithin :: forall a.
IsRangeType a =>
Field a -> Field (SqlRange a) -> Field SqlBool
liesWithin = BinOp
-> Field_ 'NonNullable a
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<@)

-- | Access the upper bound of a range. For discrete range types it is the exclusive bound.
upperBound :: T.IsRangeType a => Field (T.SqlRange a) -> FieldNullable a
upperBound :: forall a. IsRangeType a => Field (SqlRange a) -> FieldNullable a
upperBound (Column PrimExpr
range) = PrimExpr -> Field_ 'Nullable a
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field_ 'Nullable a) -> PrimExpr -> Field_ 'Nullable a
forall a b. (a -> b) -> a -> b
$ Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"upper" [PrimExpr
range]

-- | Access the lower bound of a range. For discrete range types it is the inclusive bound.
lowerBound :: T.IsRangeType a => Field (T.SqlRange a) -> FieldNullable a
lowerBound :: forall a. IsRangeType a => Field (SqlRange a) -> FieldNullable a
lowerBound (Column PrimExpr
range) = PrimExpr -> Field_ 'Nullable a
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field_ 'Nullable a) -> PrimExpr -> Field_ 'Nullable a
forall a b. (a -> b) -> a -> b
$ Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"lower" [PrimExpr
range]

infix 4 .<<
(.<<) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
.<< :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
(.<<) = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:<<)

infix 4 .>>
(.>>) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
.>> :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
(.>>) = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:>>)

infix 4 .&<
(.&<) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
.&< :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
(.&<) = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:&<)

infix 4 .&>
(.&>) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
.&> :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
(.&>) = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:&>)

infix 4 .-|-
(.-|-) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool
.-|- :: forall a. Field (SqlRange a) -> Field (SqlRange a) -> Field SqlBool
(.-|-) = BinOp
-> Field_ 'NonNullable (SqlRange a)
-> Field_ 'NonNullable (SqlRange a)
-> Field SqlBool
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:-|-)

timestamptzAtTimeZone :: F.Field T.SqlTimestamptz
                      -> F.Field T.SqlText
                      -> F.Field T.SqlTimestamp
timestamptzAtTimeZone :: Field SqlTimestamptz -> Field SqlText -> Field SqlTimestamp
timestamptzAtTimeZone = BinOp
-> Field SqlTimestamptz -> Field SqlText -> Field SqlTimestamp
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
HPQ.OpAtTimeZone

dateOfTimestamp :: F.Field T.SqlTimestamp -> F.Field T.SqlDate
dateOfTimestamp :: Field SqlTimestamp -> Field SqlDate
dateOfTimestamp (Column PrimExpr
e) = PrimExpr -> Field SqlDate
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"date" [PrimExpr
e])

-- | @IntervalNum from to@ determines from which date or time types an interval
-- can be added ('addInterval') or subtracted ('minusInterval`) and which is the
-- resulting type.
--
-- The instances should correspond to the interval + and - operations listed in:
--
-- https://www.postgresql.org/docs/current/functions-datetime.html#OPERATORS-DATETIME-TABLE
class IntervalNum from to | from -> to

instance IntervalNum T.SqlDate        T.SqlTimestamp
instance IntervalNum T.SqlInterval    T.SqlInterval
instance IntervalNum T.SqlTimestamp   T.SqlTimestamp
instance IntervalNum T.SqlTimestamptz T.SqlTimestamptz
instance IntervalNum T.SqlTime        T.SqlTime

addInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to
addInterval :: forall from to.
IntervalNum from to =>
Field from -> Field SqlInterval -> Field to
addInterval = BinOp
-> Field_ 'NonNullable from
-> Field SqlInterval
-> Field_ 'NonNullable to
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:+)

minusInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to
minusInterval :: forall from to.
IntervalNum from to =>
Field from -> Field SqlInterval -> Field to
minusInterval = BinOp
-> Field_ 'NonNullable from
-> Field SqlInterval
-> Field_ 'NonNullable to
forall (n :: Nullability) a (n' :: Nullability) b
       (n'' :: Nullability) c.
BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c
C.binOp BinOp
(HPQ.:-)

-- | Current date and time (start of current transaction)
now :: F.Field T.SqlTimestamptz
now :: Field SqlTimestamptz
now = PrimExpr -> Field SqlTimestamptz
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field SqlTimestamptz)
-> PrimExpr -> Field SqlTimestamptz
forall a b. (a -> b) -> a -> b
$ Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"now" []

data TimestampPrecision =
  MicrosecondsPrecision
  | MillisecondsPrecision
  | SecondPrecision
  | MinutePrecision
  | HourPrecision
  | DayPrecision
  | WeekPrecision
  | MonthPrecision
  | QuarterPrecision
  | YearPrecision
  | DecadePrecision
  | CenturyPrecision
  | MillenniumPrecision
  deriving Int -> TimestampPrecision -> ShowS
[TimestampPrecision] -> ShowS
TimestampPrecision -> Name
(Int -> TimestampPrecision -> ShowS)
-> (TimestampPrecision -> Name)
-> ([TimestampPrecision] -> ShowS)
-> Show TimestampPrecision
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimestampPrecision -> ShowS
showsPrec :: Int -> TimestampPrecision -> ShowS
$cshow :: TimestampPrecision -> Name
show :: TimestampPrecision -> Name
$cshowList :: [TimestampPrecision] -> ShowS
showList :: [TimestampPrecision] -> ShowS
Show

precisionToExpr :: TimestampPrecision -> HPQ.PrimExpr
precisionToExpr :: TimestampPrecision -> PrimExpr
precisionToExpr TimestampPrecision
p = Literal -> PrimExpr
HPQ.ConstExpr (Literal -> PrimExpr) -> (Name -> Literal) -> Name -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Literal
HPQ.ByteStringLit (ByteString -> Literal) -> (Name -> ByteString) -> Name -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Name -> Text) -> Name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (Name -> Text) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.dropEnd Int
9 (Text -> Text) -> (Name -> Text) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Text.pack (Name -> PrimExpr) -> Name -> PrimExpr
forall a b. (a -> b) -> a -> b
$ TimestampPrecision -> Name
forall a. Show a => a -> Name
show TimestampPrecision
p

dateTruncTimestamp :: TimestampPrecision -> F.Field T.SqlTimestamp -> F.Field T.SqlTimestamp
dateTruncTimestamp :: TimestampPrecision -> Field SqlTimestamp -> Field SqlTimestamp
dateTruncTimestamp TimestampPrecision
p (Column PrimExpr
e) = PrimExpr -> Field SqlTimestamp
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field SqlTimestamp) -> PrimExpr -> Field SqlTimestamp
forall a b. (a -> b) -> a -> b
$ Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"date_trunc" [(TimestampPrecision -> PrimExpr
precisionToExpr TimestampPrecision
p), PrimExpr
e]

dateTruncTimestamptz :: TimestampPrecision -> F.Field T.SqlTimestamptz -> F.Field T.SqlTimestamptz
dateTruncTimestamptz :: TimestampPrecision -> Field SqlTimestamptz -> Field SqlTimestamptz
dateTruncTimestamptz TimestampPrecision
p (Column PrimExpr
e) = PrimExpr -> Field SqlTimestamptz
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column (PrimExpr -> Field SqlTimestamptz)
-> PrimExpr -> Field SqlTimestamptz
forall a b. (a -> b) -> a -> b
$ Name -> [PrimExpr] -> PrimExpr
HPQ.FunExpr Name
"date_trunc" [(TimestampPrecision -> PrimExpr
precisionToExpr TimestampPrecision
p), PrimExpr
e]