beam-core-0.9.0.0: Database/Beam/Query/Ord.hs
{-# LANGUAGE UndecidableInstances #-}
-- | Defines classen 'SqlEq' and 'SqlOrd' that can be used to perform equality
-- and comparison operations on certain expressions.
--
-- In particular, any 'Beamable' value over 'QGenExpr' or any 'QGenExpr'
-- object can be compared for equality and inequality using the '(==.)' and
-- '(/=.)' operators respectively.
--
-- Simple (scalar) 'QGenExpr's can be compared using the '(<.)', '(>.)',
-- '(<=.)', and '(>=.)' operators respectively.
--
-- The "Quantified Comparison Syntax" (i.e., @.. > ANY (..)@) is supported
-- using the corresponding operators suffixed with a @*@ before the dot. For
-- example, @x == ANY(SELECT ..)@ can be written.
--
-- > x ==*. anyOf_ ..
--
-- Or, for example, @x > ALL(SELECT ..)@ can be written
--
-- > x >*. allOf_ ..
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 Database.Beam.Backend.SQL.AST (Expression)
--import Database.Beam.Backend.SQL.Builder (SqlSyntaxBackend)
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
-- | A data structure representing the set to quantify a comparison operator over.
data QQuantified be s r
= QQuantified (BeamSqlBackendExpressionQuantifierSyntax be) (WithExprContext (BeamSqlBackendExpressionSyntax be))
-- | Convert a /known not null/ bool to a 'SqlBool'. See 'unknownAs_' for the inverse
sqlBool_ :: QGenExpr context syntax s Bool -> QGenExpr context syntax s SqlBool
sqlBool_ (QExpr s) = QExpr s
-- | SQL @IS TRUE@ operator
isTrue_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isTrue_ (QExpr s) = QExpr (fmap isTrueE s)
-- | SQL @IS NOT TRUE@ operator
isNotTrue_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotTrue_ (QExpr s) = QExpr (fmap isNotTrueE s)
-- | SQL @IS FALSE@ operator
isFalse_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isFalse_ (QExpr s) = QExpr (fmap isFalseE s)
-- | SQL @IS NOT FALSE@ operator
isNotFalse_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotFalse_ (QExpr s) = QExpr (fmap isNotFalseE s)
-- | SQL @IS UNKNOWN@ operator
isUnknown_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isUnknown_ (QExpr s) = QExpr (fmap isUnknownE s)
-- | SQL @IS NOT UNKNOWN@ operator
isNotUnknown_ :: BeamSqlBackend be
=> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
isNotUnknown_ (QExpr s) = QExpr (fmap isNotUnknownE s)
-- | Return the first argument if the expression has the unknown SQL value
-- See 'sqlBool_' for the inverse
unknownAs_ :: BeamSqlBackend be
=> Bool -> QGenExpr context be s SqlBool -> QGenExpr context be s Bool
unknownAs_ False = isTrue_ -- If unknown is being treated as false, then return true only if the expression is true
unknownAs_ True = isNotFalse_ -- If unknown is being treated as true, then return true only if the expression is not false
-- | Retrieve a 'SqlBool' value as a potentially @NULL@ 'Bool'. This
-- is useful if you want to get the value of a SQL boolean expression
-- directly, without having to specify what to do on @UNKNOWN@. Note
-- that both @NULL@ and @UNKNOWN@ will be returned as 'Nothing'.
possiblyNullBool_ :: QGenExpr context be s SqlBool -> QGenExpr context be s (Maybe Bool)
possiblyNullBool_ (QExpr e) = QExpr e
-- | Convert a possibly @NULL@ 'Bool' to a 'SqlBool'.
fromPossiblyNullBool_ :: QGenExpr context be s (Maybe Bool) -> QGenExpr context be s SqlBool
fromPossiblyNullBool_ (QExpr e) = QExpr e
-- | A 'QQuantified' representing a SQL @ALL(..)@ for use with a
-- <#quantified-comparison-operator quantified comparison operator>
--
-- Accepts a subquery. Use 'allIn_' for an explicit list
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))
-- | A 'QQuantified' representing a SQL @ALL(..)@ for use with a
-- <#quantified-comparison-operator quantified comparison operator>
--
-- Accepts an explicit list of typed expressions. Use 'allOf_' for
-- a subquery
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)
-- | A 'QQuantified' representing a SQL @ANY(..)@ for use with a
-- <#quantified-comparison-operator quantified comparison operator>
--
-- Accepts a subquery. Use 'anyIn_' for an explicit list
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))
-- | A 'QQuantified' representing a SQL @ANY(..)@ for use with a
-- <#quantified-comparison-operator quantified comparison operator>
--
-- Accepts an explicit list of typed expressions. Use 'anyOf_' for
-- a subquery
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)
-- | SQL @BETWEEN@ clause
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
-- | SQL @IN@ predicate
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 for backends which support SQL @IN@ on lists of row values, which is
-- not part of ANSI SQL. This is useful for @IN@ on primary keys.
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 for expression types or expression containers for which there is a
-- notion of equality.
--
-- Instances are provided to check the equality of expressions of the same
-- type as well as entire 'Beamable' types parameterized over 'QGenExpr'
class SqlEq expr a | a -> expr where
-- | Given two expressions, returns whether they are equal, using Haskell semantics (NULLs handled properly)
(==.) :: a -> a -> expr Bool
-- | Given two expressions, returns whether they are not equal, using Haskell semantics (NULLs handled properly)
(/=.) :: a -> a -> expr Bool
-- | Given two expressions, returns the /SQL tri-state boolean/ when compared for equality
(==?.) :: a -> a -> expr SqlBool
-- | Given two expressions, returns the /SQL tri-state boolean/ when compared for inequality
(/=?.) :: a -> a -> expr SqlBool
-- | Class for expression types for which there is a notion of /quantified/
-- equality.
class SqlEq expr a => SqlEqQuantified expr quantified a | a -> expr quantified where
-- | Quantified equality and inequality using /SQL semantics/ (tri-state boolean)
(==*.), (/=*.) :: a -> quantified -> expr SqlBool
infix 4 ==., /=., ==?., /=?., ==*., /=*.
infix 4 <., >., <=., >=.
infix 4 <*., >*., <=*., >=*.
-- | Class for Haskell types that can be compared for equality in the given backend
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
-- | Tri-state equality
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 for Haskell types that can be compared for quantified equality in the given backend
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)
-- | Compare two arbitrary expressions (of the same type) for equality
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))
-- | Two arbitrary expressions can be quantifiably compared for equality.
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)
-- | Constraint synonym to check if two tables can be compared for equality
type HasTableEquality be tbl =
(FieldsFulfillConstraint (HasSqlEqualityCheck be) tbl, Beamable tbl)
type HasTableEqualityNullable be tbl =
(FieldsFulfillConstraintNullable (HasSqlEqualityCheck be) tbl, Beamable tbl)
-- | Compare two arbitrary 'Beamable' types containing 'QGenExpr's for equality.
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)
-- * Comparisons
-- | Class for expression types or expression containers for which there is a
-- notion of ordering.
--
-- Instances are provided to check the ordering of expressions of the same
-- type. Since there is no universal notion of ordering for an arbitrary
-- number of expressions, no instance is provided for 'Beamable' types.
class SqlOrd expr e | e -> expr where
(<.), (>.), (<=.), (>=.) :: e -> e -> expr Bool
-- | Class for things which can be /quantifiably/ compared.
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)