{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Opaleye.Operators (module Opaleye.Operators) where
import qualified Control.Arrow as A
import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NEL
import qualified Opaleye.Field as F
import Opaleye.Internal.Column (Column(Column), unsafeCase_,
unsafeIfThenElse, unsafeGt)
import qualified Opaleye.Internal.Column as C
import Opaleye.Internal.QueryArr (QueryArr(QueryArr), Query, runSimpleQueryArr)
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.Operators as O
import Opaleye.Internal.Helpers ((.:))
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.Distinct as Distinct
import qualified Opaleye.Join as Join
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Data.Profunctor.Product.Default as D
restrict :: S.SelectArr (F.Field T.SqlBool) ()
restrict = QueryArr f where
f (Column predicate, primQ, t0) = ((), PQ.restrict predicate primQ, t0)
restrictExists :: S.SelectArr a b -> S.SelectArr a ()
restrictExists criteria = QueryArr f where
f (a, primQ, t0) = ((), PQ.exists primQ existsQ, t1) where
(_, existsQ, t1) = runSimpleQueryArr criteria (a, t0)
restrictNotExists :: S.SelectArr a b -> S.SelectArr a ()
restrictNotExists criteria = QueryArr f where
f (a, primQ, t0) = ((), PQ.notExists primQ existsQ, t1) where
(_, existsQ, t1) = runSimpleQueryArr criteria (a, t0)
keepWhen :: (a -> F.Field T.SqlBool) -> S.SelectArr a a
keepWhen p = proc a -> do
restrict -< p a
A.returnA -< a
infix 4 .==
(.==) :: Column a -> Column a -> F.Field T.SqlBool
(.==) = C.binOp (HPQ.:==)
infix 4 ./=
(./=) :: Column a -> Column a -> F.Field T.SqlBool
(./=) = C.binOp (HPQ.:<>)
infix 4 .===
(.===) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool
(.===) = (O..==)
infix 4 ./==
(./==) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool
(./==) = Opaleye.Operators.not .: (O..==)
infix 4 .>
(.>) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool
(.>) = unsafeGt
infix 4 .<
(.<) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool
(.<) = C.binOp (HPQ.:<)
infix 4 .<=
(.<=) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool
(.<=) = C.binOp (HPQ.:<=)
infix 4 .>=
(.>=) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool
(.>=) = C.binOp (HPQ.:>=)
quot_ :: C.SqlIntegral a => Column a -> Column a -> Column a
quot_ = C.binOp (HPQ.:/)
rem_ :: C.SqlIntegral a => Column a -> Column a -> Column a
rem_ = C.binOp HPQ.OpMod
case_ :: [(F.Field T.SqlBool, Column a)] -> Column a -> Column a
case_ = unsafeCase_
ifThenElse :: F.Field T.SqlBool -> Column a -> Column a -> Column a
ifThenElse = unsafeIfThenElse
ifThenElseMany :: D.Default O.IfPP fields fields
=> F.Field T.SqlBool
-> fields
-> fields
-> fields
ifThenElseMany = O.ifExplict D.def
infixr 2 .||
(.||) :: F.Field T.SqlBool -> F.Field T.SqlBool -> F.Field T.SqlBool
(.||) = C.binOp HPQ.OpOr
infixr 3 .&&
(.&&) :: F.Field T.SqlBool -> F.Field T.SqlBool -> F.Field T.SqlBool
(.&&) = (O..&&)
not :: F.Field T.SqlBool -> F.Field T.SqlBool
not = C.unOp HPQ.OpNot
ors :: F.Foldable f => f (F.Field T.SqlBool) -> F.Field T.SqlBool
ors = F.foldl' (.||) (T.sqlBool False)
(.++) :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlText
(.++) = C.binOp (HPQ.:||)
lower :: F.Field T.SqlText -> F.Field T.SqlText
lower = C.unOp HPQ.OpLower
upper :: F.Field T.SqlText -> F.Field T.SqlText
upper = C.unOp HPQ.OpUpper
like :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlBool
like = C.binOp HPQ.OpLike
ilike :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlBool
ilike = C.binOp HPQ.OpILike
charLength :: C.PGString a => Column a -> Column Int
charLength (Column e) = Column (HPQ.FunExpr "char_length" [e])
in_ :: (Functor f, F.Foldable f) => f (Column a) -> Column a -> F.Field T.SqlBool
in_ fcas (Column a) = Column $ case NEL.nonEmpty (F.toList fcas) of
Nothing -> HPQ.ConstExpr (HPQ.BoolLit False)
Just xs -> HPQ.BinExpr HPQ.OpIn a (HPQ.ListExpr (fmap C.unColumn xs))
inQuery :: D.Default O.EqPP fields fields
=> fields -> Query fields -> S.Select (F.Field T.SqlBool)
inQuery c q = qj'
where
q' = A.arr (const 1)
A.<<< keepWhen (c .===)
A.<<< q
qj :: Query (F.Field T.SqlInt4, Column (C.Nullable T.SqlInt4))
qj = Join.leftJoin (A.arr (const 1))
(Distinct.distinct q')
(uncurry (.==))
qj' :: Query (F.Field T.SqlBool)
qj' = A.arr (Opaleye.Operators.not
. Column.isNull
. snd)
A.<<< qj
class PGIsJson a
type SqlIsJson = PGIsJson
instance PGIsJson T.SqlJson
instance PGIsJson T.SqlJsonb
class PGJsonIndex a
type SqlJsonIndex = PGJsonIndex
instance PGJsonIndex T.SqlInt4
instance PGJsonIndex T.SqlInt8
instance PGJsonIndex T.SqlText
infixl 8 .->
(.->) :: (SqlIsJson a, SqlJsonIndex k)
=> F.FieldNullable a
-> F.Field k
-> F.FieldNullable a
(.->) = C.binOp (HPQ.:->)
infixl 8 .->>
(.->>) :: (SqlIsJson a, SqlJsonIndex k)
=> F.FieldNullable a
-> F.Field k
-> F.FieldNullable T.SqlText
(.->>) = C.binOp (HPQ.:->>)
infixl 8 .#>
(.#>) :: (SqlIsJson a)
=> F.FieldNullable a
-> Column (T.SqlArray T.SqlText)
-> F.FieldNullable a
(.#>) = C.binOp (HPQ.:#>)
infixl 8 .#>>
(.#>>) :: (SqlIsJson a)
=> F.FieldNullable a
-> Column (T.SqlArray T.SqlText)
-> F.FieldNullable T.SqlText
(.#>>) = C.binOp (HPQ.:#>>)
infix 4 .@>
(.@>) :: F.Field T.SqlJsonb -> F.Field T.SqlJsonb -> F.Field T.SqlBool
(.@>) = C.binOp (HPQ.:@>)
infix 4 .<@
(.<@) :: F.Field T.SqlJsonb -> F.Field T.SqlJsonb -> F.Field T.SqlBool
(.<@) = C.binOp (HPQ.:<@)
infix 4 .?
(.?) :: F.Field T.SqlJsonb -> F.Field T.SqlText -> F.Field T.SqlBool
(.?) = C.binOp (HPQ.:?)
infix 4 .?|
(.?|) :: F.Field T.SqlJsonb
-> Column (T.SqlArray T.SqlText)
-> F.Field T.SqlBool
(.?|) = C.binOp (HPQ.:?|)
infix 4 .?&
(.?&) :: F.Field T.SqlJsonb
-> Column (T.SqlArray T.SqlText)
-> F.Field T.SqlBool
(.?&) = C.binOp (HPQ.:?&)
emptyArray :: T.IsSqlType a => Column (T.SqlArray a)
emptyArray = T.sqlArray id []
arrayPrepend :: Column a -> Column (T.SqlArray a) -> Column (T.SqlArray a)
arrayPrepend (Column e) (Column es) = Column (HPQ.FunExpr "array_prepend" [e, es])
singletonArray :: T.IsSqlType a => Column a -> Column (T.SqlArray a)
singletonArray x = arrayPrepend x emptyArray
index :: (C.SqlIntegral n) => Column (T.SqlArray a) -> Column n -> Column (C.Nullable a)
index (Column a) (Column b) = Column (HPQ.ArrayIndex a b)
overlap :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
overlap = C.binOp (HPQ.:&&)
liesWithin :: T.IsRangeType a => Column a -> Column (T.SqlRange a) -> F.Field T.SqlBool
liesWithin = C.binOp (HPQ.:<@)
upperBound :: T.IsRangeType a => Column (T.SqlRange a) -> Column (C.Nullable a)
upperBound (Column range) = Column $ HPQ.FunExpr "upper" [range]
lowerBound :: T.IsRangeType a => Column (T.SqlRange a) -> Column (C.Nullable a)
lowerBound (Column range) = Column $ HPQ.FunExpr "lower" [range]
infix 4 .<<
(.<<) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
(.<<) = C.binOp (HPQ.:<<)
infix 4 .>>
(.>>) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
(.>>) = C.binOp (HPQ.:>>)
infix 4 .&<
(.&<) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
(.&<) = C.binOp (HPQ.:&<)
infix 4 .&>
(.&>) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
(.&>) = C.binOp (HPQ.:&>)
infix 4 .-|-
(.-|-) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool
(.-|-) = C.binOp (HPQ.:-|-)
timestamptzAtTimeZone :: F.Field T.SqlTimestamptz
-> F.Field T.SqlText
-> F.Field T.SqlTimestamp
timestamptzAtTimeZone = C.binOp HPQ.OpAtTimeZone
{-# DEPRECATED doubleOfInt
"Use 'C.unsafeCast' instead. \
\Will be removed in version 0.7." #-}
doubleOfInt :: F.Field T.SqlInt4 -> F.Field T.SqlFloat8
doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e)
exists :: QueryArr a b -> QueryArr a ()
exists = restrictExists
notExists :: QueryArr a b -> QueryArr a ()
notExists = restrictNotExists