{-# LANGUAGE UndecidableInstances #-}
module Database.Beam.Query.Ord
( SqlEq(..), SqlEqQuantified(..), SqlIn(..)
, HasSqlInTable(..)
, SqlOrd(..), SqlOrdQuantified(..)
, QQuantified(..)
, HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)
, HasTableEquality, HasTableEqualityNullable
, isTrue_, isNotTrue_
, isFalse_, isNotFalse_
, isUnknown_, isNotUnknown_
, unknownAs_, sqlBool_
, possiblyNullBool_
, fromPossiblyNullBool_
, anyOf_, anyIn_
, allOf_, allIn_
, between_
) where
import Database.Beam.Query.Internal
import Database.Beam.Query.Types
import Database.Beam.Query.Operator
import Database.Beam.Schema.Tables
import Database.Beam.Backend.SQL
import Control.Applicative
import Control.Monad.State
import Data.Maybe
import Data.Proxy
import Data.Kind
import Data.Word
import Data.Int
import Data.Tagged
import Data.Text (Text)
import Data.Time (UTCTime, LocalTime, Day, TimeOfDay)
import GHC.TypeLits
data QQuantified be s r
= QQuantified (BeamSqlBackendExpressionQuantifierSyntax be) (WithExprContext (BeamSqlBackendExpressionSyntax be))
sqlBool_ :: QGenExpr context syntax s Bool -> QGenExpr context syntax s SqlBool
sqlBool_ (QExpr s) = QExpr s
isTrue_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isTrue_ (QExpr s) = QExpr (fmap isTrueE s)
isNotTrue_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotTrue_ (QExpr s) = QExpr (fmap isNotTrueE s)
isFalse_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isFalse_ (QExpr s) = QExpr (fmap isFalseE s)
isNotFalse_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotFalse_ (QExpr s) = QExpr (fmap isNotFalseE s)
isUnknown_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isUnknown_ (QExpr s) = QExpr (fmap isUnknownE s)
isNotUnknown_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotUnknown_ (QExpr s) = QExpr (fmap isNotUnknownE s)
unknownAs_ :: BeamSqlBackend be
=> Bool -> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
unknownAs_ False = isTrue_
unknownAs_ True = isNotFalse_
possiblyNullBool_ :: QGenExpr context be s SqlBool -> QGenExpr context be s (Maybe Bool)
possiblyNullBool_ (QExpr e) = QExpr e
fromPossiblyNullBool_ :: QGenExpr context be s (Maybe Bool) -> QGenExpr context be s SqlBool
fromPossiblyNullBool_ (QExpr e) = QExpr e
allOf_
:: forall s a be db
. ( BeamSqlBackend be, HasQBuilder be )
=> Q be db (QNested s) (QExpr be (QNested s) a)
-> QQuantified be s a
allOf_ s = QQuantified quantifyOverAll (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))
allIn_
:: forall s a be
. BeamSqlBackend be
=> [QExpr be s a]
-> QQuantified be s a
allIn_ es = QQuantified quantifyOverAll (quantifierListE <$> mapM (\(QExpr e) -> e) es)
anyOf_
:: forall s a be db
. ( BeamSqlBackend be, HasQBuilder be )
=> Q be db (QNested s) (QExpr be (QNested s) a)
-> QQuantified be s a
anyOf_ s = QQuantified quantifyOverAny (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))
anyIn_
:: forall s a be
. BeamSqlBackend be
=> [QExpr be s a]
-> QQuantified be s a
anyIn_ es = QQuantified quantifyOverAny (quantifierListE <$> mapM (\(QExpr e) -> e) es)
between_ :: BeamSqlBackend be
=> QGenExpr context be s a -> QGenExpr context be s a
-> QGenExpr context be s a -> QGenExpr context be s Bool
between_ (QExpr a) (QExpr min_) (QExpr max_) =
QExpr (liftA3 betweenE a min_ max_)
class SqlIn expr a | a -> expr where
in_ :: a -> [ a ] -> expr Bool
instance BeamSqlBackend be => SqlIn (QGenExpr context be s) (QGenExpr context be s a) where
in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False)))
in_ (QExpr row) options = QExpr (inE <$> row <*> mapM (\(QExpr o) -> o) options)
class BeamSqlBackend be => HasSqlInTable be where
inRowValuesE
:: Proxy be
-> BeamSqlBackendExpressionSyntax be
-> [ BeamSqlBackendExpressionSyntax be ]
-> BeamSqlBackendExpressionSyntax be
inRowValuesE Proxy = inE
instance ( HasSqlInTable be, Beamable table ) =>
SqlIn (QGenExpr context be s) (table (QGenExpr context be s)) where
in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False)))
in_ row options = QExpr (inRowValuesE (Proxy @be) <$> toExpr row <*> (mapM toExpr options))
where toExpr :: table (QGenExpr context be s) -> TablePrefix -> BeamSqlBackendExpressionSyntax be
toExpr = fmap rowE . sequence . allBeamValues (\(Columnar' (QExpr x)) -> x)
infix 4 `between_`, `in_`
class SqlEq expr a | a -> expr where
(==.) :: a -> a -> expr Bool
(/=.) :: a -> a -> expr Bool
(==?.) :: a -> a -> expr SqlBool
(/=?.) :: a -> a -> expr SqlBool
class SqlEq expr a => SqlEqQuantified expr quantified a | a -> expr quantified where
(==*.), (/=*.) :: a -> quantified -> expr SqlBool
infix 4 ==., /=., ==?., /=?., ==*., /=*.
infix 4 <., >., <=., >=.
infix 4 <*., >*., <=*., >=*.
class BeamSqlBackend be => HasSqlEqualityCheck be a where
sqlEqE, sqlNeqE :: Proxy a -> Proxy be
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
sqlEqE _ _ = eqE Nothing
sqlNeqE _ _ = neqE Nothing
sqlEqTriE, sqlNeqTriE :: Proxy a -> Proxy be
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
sqlEqTriE _ _ = eqE Nothing
sqlNeqTriE _ _ = neqE Nothing
type family CanCheckMaybeEquality a :: Constraint where
CanCheckMaybeEquality (Maybe a) =
TypeError ('Text "Attempt to check equality of nested Maybe." ':$$:
'Text "Beam can only reasonably check equality of a single nesting of Maybe.")
CanCheckMaybeEquality a = ()
instance (HasSqlEqualityCheck be a, CanCheckMaybeEquality a) => HasSqlEqualityCheck be (Maybe a) where
sqlEqE _ _ a b = eqMaybeE a b (sqlEqE (Proxy @a) (Proxy @be) a b)
sqlNeqE _ _ a b = neqMaybeE a b (sqlNeqE (Proxy @a) (Proxy @be) a b)
instance HasSqlEqualityCheck be a => HasSqlEqualityCheck be (SqlSerial a) where
sqlEqE _ = sqlEqE (Proxy @a)
sqlNeqE _ = sqlNeqE (Proxy @a)
sqlEqTriE _ = sqlEqTriE (Proxy @a)
sqlNeqTriE _ = sqlNeqTriE (Proxy @a)
class HasSqlEqualityCheck be a => HasSqlQuantifiedEqualityCheck be a where
sqlQEqE, sqlQNeqE :: Proxy a -> Proxy be
-> Maybe (BeamSqlBackendExpressionQuantifierSyntax be)
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
-> BeamSqlBackendExpressionSyntax be
sqlQEqE _ _ = eqE
sqlQNeqE _ _ = neqE
instance (HasSqlQuantifiedEqualityCheck syntax a, CanCheckMaybeEquality a) => HasSqlQuantifiedEqualityCheck syntax (Maybe a) where
sqlQEqE _ = sqlQEqE (Proxy @a)
sqlQNeqE _ = sqlQNeqE (Proxy @a)
instance HasSqlQuantifiedEqualityCheck syntax a => HasSqlQuantifiedEqualityCheck syntax (SqlSerial a) where
sqlQEqE _ = sqlQEqE (Proxy @a)
sqlQNeqE _ = sqlQNeqE (Proxy @a)
instance ( BeamSqlBackend be, HasSqlEqualityCheck be a ) =>
SqlEq (QGenExpr context be s) (QGenExpr context be s a) where
(==.) = qBinOpE (sqlEqE (Proxy @a) (Proxy @be))
(/=.) = qBinOpE (sqlNeqE (Proxy @a) (Proxy @be))
(==?.) = qBinOpE (sqlEqTriE (Proxy @a) (Proxy @be))
(/=?.) = qBinOpE (sqlNeqTriE (Proxy @a) (Proxy @be))
instance ( BeamSqlBackend be, HasSqlQuantifiedEqualityCheck be a ) =>
SqlEqQuantified (QGenExpr context be s) (QQuantified be s a) (QGenExpr context be s a) where
a ==*. QQuantified q b = qBinOpE (sqlQEqE (Proxy @a) (Proxy @be) (Just q)) a (QExpr b)
a /=*. QQuantified q b = qBinOpE (sqlQNeqE (Proxy @a) (Proxy @be) (Just q)) a (QExpr b)
type HasTableEquality be tbl =
(FieldsFulfillConstraint (HasSqlEqualityCheck be) tbl, Beamable tbl)
type HasTableEqualityNullable be tbl =
(FieldsFulfillConstraintNullable (HasSqlEqualityCheck be) tbl, Beamable tbl)
instance ( BeamSqlBackend be, Beamable tbl
, FieldsFulfillConstraint (HasSqlEqualityCheck be) tbl ) =>
SqlEq (QGenExpr context be s) (tbl (QGenExpr context be s)) where
a ==. b = let (_, e) = runState (zipBeamFieldsM
(\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->
do modify (\expr ->
case expr of
Nothing -> Just $ x ==. y
Just expr' -> Just $ expr' &&. x ==. y)
return x') (withConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing
in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e
a /=. b = not_ (a ==. b)
a ==?. b = let (_, e) = runState (zipBeamFieldsM
(\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->
do modify (\expr ->
case expr of
Nothing -> Just $ x ==?. y
Just expr' -> Just $ expr' &&?. x ==?. y)
return x') (withConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing
in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e
a /=?. b = sqlNot_ (a ==?. b)
instance ( BeamSqlBackend be, Beamable tbl
, FieldsFulfillConstraintNullable (HasSqlEqualityCheck be) tbl )
=> SqlEq (QGenExpr context be s) (tbl (Nullable (QGenExpr context be s))) where
a ==. b = let (_, e) = runState (zipBeamFieldsM
(\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) -> do
modify (\expr ->
case expr of
Nothing -> Just $ x ==. y
Just expr' -> Just $ expr' &&. x ==. y)
return x')
(withNullableConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing
in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e
a /=. b = not_ (a ==. b)
a ==?. b = let (_, e) = runState (zipBeamFieldsM
(\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->
do modify (\expr ->
case expr of
Nothing -> Just $ x ==?. y
Just expr' -> Just $ expr' &&?. x ==?. y)
return x') (withNullableConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing
in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e
a /=?. b = sqlNot_ (a ==?. b)
class SqlOrd expr e | e -> expr where
(<.), (>.), (<=.), (>=.) :: e -> e -> expr Bool
class SqlOrd expr e =>
SqlOrdQuantified expr quantified e | e -> expr quantified where
(<*.), (>*.), (<=*.), (>=*.) :: e -> quantified -> expr Bool
instance BeamSqlBackend be =>
SqlOrd (QGenExpr context be s) (QGenExpr context be s a) where
(<.) = qBinOpE (ltE Nothing)
(>.) = qBinOpE (gtE Nothing)
(<=.) = qBinOpE (leE Nothing)
(>=.) = qBinOpE (geE Nothing)
instance BeamSqlBackend be =>
SqlOrdQuantified (QGenExpr context be s) (QQuantified be s a) (QGenExpr context be s a) where
a <*. QQuantified q b = qBinOpE (ltE (Just q)) a (QExpr b)
a <=*. QQuantified q b = qBinOpE (leE (Just q)) a (QExpr b)
a >*. QQuantified q b = qBinOpE (gtE (Just q)) a (QExpr b)
a >=*. QQuantified q b = qBinOpE (geE (Just q)) a (QExpr b)
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Text
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Integer
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int8
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int16
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int32
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int64
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word8
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word16
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word32
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word64
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Double
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Float
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Bool
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) UTCTime
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) LocalTime
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Day
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) TimeOfDay
instance ( BeamSqlBackend (MockSqlBackend cmd)
, HasSqlEqualityCheck (MockSqlBackend cmd) a
) => HasSqlEqualityCheck (MockSqlBackend cmd) (Tagged t a)
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Text
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Integer
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int8
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int16
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int32
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int64
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word8
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word16
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word32
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word64
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Double
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Float
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Bool
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) UTCTime
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) LocalTime
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Day
instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) TimeOfDay
instance ( BeamSqlBackend (MockSqlBackend cmd)
, HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) a
) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) (Tagged t a)