{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Beam.Query.Combinators
(
coalesce_, fromMaybe_, position_
, charLength_, octetLength_, bitLength_
, currentTimestamp_
, lower_, upper_
, trim_
, if_, then_, else_
, then_'
, (<-.), current_
, HaskellLiteralForQExpr
, SqlValable(..), SqlValableTable
, default_
, all_
, allFromView_, join_, join_'
, guard_, guard_', filter_, filter_'
, related_, relatedBy_, relatedBy_'
, leftJoin_, leftJoin_'
, perhaps_, outerJoin_, outerJoin_'
, subselect_, references_
, nub_
, SqlJustable(..)
, SqlDeconstructMaybe(..)
, SqlOrderable
, QIfCond, QIfElse
, (<|>.)
, limit_, offset_
, as_
, exists_, unique_, distinct_, subquery_
, union_, unionAll_
, intersect_, intersectAll_
, except_, exceptAll_
, over_, frame_, bounds_, unbounded_, nrows_, fromBound_
, noBounds_, noOrder_, noPartition_
, partitionBy_, orderPartitionBy_, withWindow_
, orderBy_, asc_, desc_, nullsFirst_, nullsLast_
) where
import Database.Beam.Backend.Types
import Database.Beam.Backend.SQL
import Database.Beam.Query.Internal
import Database.Beam.Query.Ord
import Database.Beam.Query.Operator
import Database.Beam.Query.Types
import Database.Beam.Schema.Tables
#if !MIN_VERSION_base(4, 11, 0)
import Control.Monad.Writer
#endif
import Control.Monad.Identity
import Control.Monad.Free
import Control.Applicative
import Data.Maybe
import Data.Proxy
import Data.Time (LocalTime)
import GHC.Generics
all_ :: forall be (db :: (* -> *) -> *) table select s.
( Database be db
, IsSql92SelectSyntax select
, IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))
, IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)))
, Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)
, Table table )
=> DatabaseEntity be db (TableEntity table)
-> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
all_ (DatabaseEntity (DatabaseTable tblNm tblSettings)) =
Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd)
allFromView_ :: forall be (db :: (* -> *) -> *) table select s.
( Database be db
, IsSql92SelectSyntax select
, IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))
, IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)))
, Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)
, Beamable table )
=> DatabaseEntity be db (ViewEntity table)
-> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
allFromView_ (DatabaseEntity (DatabaseView tblNm tblSettings)) =
Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd)
join_ :: ( Database be db, Table table
, IsSql92SelectSyntax select
, IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))
, Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)
, IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))) ) =>
DatabaseEntity be db (TableEntity table)
-> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)
-> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
join_ tbl mkOn = join_' tbl (sqlBool_ . mkOn)
join_' :: ( Database be db, Table table
, IsSql92SelectSyntax select
, IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))
, Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)
, IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))) ) =>
DatabaseEntity be db (TableEntity table)
-> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)
-> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
join_' (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkOn =
Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\tbl -> let QExpr on = mkOn tbl in Just on) snd)
perhaps_ :: forall s r select db.
( Projectible (Sql92SelectExpressionSyntax select) r
, IsSql92SelectSyntax select
, ThreadRewritable (QNested s) r
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )
=> Q select db (QNested s) r
-> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
perhaps_ (Q sub) =
Q $ liftF (QArbitraryJoin
sub leftJoin
(\_ -> Nothing)
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) a) ->
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) a) $
rewriteThread (Proxy @s) r))
outerJoin_ :: forall s a b select db.
( Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b
, ThreadRewritable (QNested s) a, ThreadRewritable (QNested s) b
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s a)
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s b)
, IsSql92FromOuterJoinSyntax (Sql92SelectFromSyntax select) )
=> Q select db (QNested s) a
-> Q select db (QNested s) b
-> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr (Sql92SelectExpressionSyntax select) s Bool )
-> Q select db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)
, Retag Nullable (WithRewrittenThread (QNested s) s b) )
outerJoin_ a b on_ = outerJoin_' a b (sqlBool_ . on_)
outerJoin_' :: forall s a b select db.
( Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b
, ThreadRewritable (QNested s) a, ThreadRewritable (QNested s) b
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s a)
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s b)
, IsSql92FromOuterJoinSyntax (Sql92SelectFromSyntax select) )
=> Q select db (QNested s) a
-> Q select db (QNested s) b
-> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr (Sql92SelectExpressionSyntax select) s SqlBool )
-> Q select db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)
, Retag Nullable (WithRewrittenThread (QNested s) s b) )
outerJoin_' (Q a) (Q b) on_ =
Q $ liftF (QTwoWayJoin a b outerJoin
(\(a', b') ->
let QExpr e = on_ (rewriteThread (Proxy @s) a', rewriteThread (Proxy @s) b')
in Just e)
(\(a', b') ->
let retag' :: (ThreadRewritable (QNested s) x, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s x))
=> x -> Retag Nullable (WithRewrittenThread (QNested s) s x)
retag' = retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) x) ->
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) x) .
rewriteThread (Proxy @s)
in ( retag' a', retag' b' )))
leftJoin_ :: forall s r select db.
( Projectible (Sql92SelectExpressionSyntax select) r
, IsSql92SelectSyntax select
, ThreadRewritable (QNested s) r
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )
=> Q select db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr (Sql92SelectExpressionSyntax select) s Bool)
-> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_ sub on_ = leftJoin_' sub (sqlBool_ . on_)
leftJoin_' :: forall s r select db.
( Projectible (Sql92SelectExpressionSyntax select) r
, IsSql92SelectSyntax select
, ThreadRewritable (QNested s) r
, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )
=> Q select db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr (Sql92SelectExpressionSyntax select) s SqlBool)
-> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_' (Q sub) on_ =
Q $ liftF (QArbitraryJoin
sub leftJoin
(\r -> let QExpr e = on_ (rewriteThread (Proxy @s) r) in Just e)
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) a) ->
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) a) $
rewriteThread (Proxy @s) r))
subselect_ :: forall s r select db.
( ThreadRewritable (QNested s) r
, ProjectibleInSelectSyntax select r )
=> Q select db (QNested s) r
-> Q select db s (WithRewrittenThread (QNested s) s r)
subselect_ (Q q') =
Q (liftF (QSubSelect q' (rewriteThread (Proxy @s))))
guard_ :: forall select db s.
( IsSql92SelectSyntax select ) =>
QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool -> Q select db s ()
guard_ = guard_' . sqlBool_
guard_' :: forall select db s
. IsSql92SelectSyntax select
=> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool -> Q select db s ()
guard_' (QExpr guardE') = Q (liftF (QGuard guardE' ()))
filter_ :: forall r select db s.
( IsSql92SelectSyntax select )
=> (r -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)
-> Q select db s r -> Q select db s r
filter_ mkExpr clause = clause >>= \x -> guard_ (mkExpr x) >> pure x
filter_' :: forall r select db s.
( IsSql92SelectSyntax select )
=> (r -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)
-> Q select db s r -> Q select db s r
filter_' mkExpr clause = clause >>= \x -> guard_' (mkExpr x) >> pure x
related_ :: forall be db rel select s.
( IsSql92SelectSyntax select
, HasTableEquality (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) (PrimaryKey rel)
, HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool
, Database be db, Table rel ) =>
DatabaseEntity be db (TableEntity rel)
-> PrimaryKey rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s)
-> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
related_ relTbl relKey =
join_ relTbl (\rel -> relKey ==. primaryKey rel)
relatedBy_ :: forall be db rel select s.
( Database be db, Table rel
, HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool
, IsSql92SelectSyntax select )
=> DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s) ->
QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)
-> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
relatedBy_ = join_
relatedBy_' :: forall be db rel select s.
( Database be db, Table rel
, HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool
, IsSql92SelectSyntax select )
=> DatabaseEntity be db (TableEntity rel)
-> (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s) ->
QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)
-> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))
relatedBy_' = join_'
references_ :: ( IsSql92ExpressionSyntax expr
, HasTableEquality expr (PrimaryKey t)
, HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Bool
, Table t )
=> PrimaryKey t (QGenExpr ctxt expr s) -> t (QGenExpr ctxt expr s) -> QGenExpr ctxt expr s Bool
references_ fk tbl = fk ==. pk tbl
nub_ :: ( IsSql92SelectSyntax select
, Projectible (Sql92SelectExpressionSyntax select) r )
=> Q select db s r -> Q select db s r
nub_ (Q sub) = Q $ liftF (QDistinct (\_ _ -> setQuantifierDistinct) sub id)
limit_ :: forall s a select db.
( ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a ) =>
Integer -> Q select db (QNested s) a -> Q select db s (WithRewrittenThread (QNested s) s a)
limit_ limit' (Q q) =
Q (liftF (QLimit limit' q (rewriteThread (Proxy @s))))
offset_ :: forall s a select db.
( ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a ) =>
Integer -> Q select db (QNested s) a -> Q select db s (WithRewrittenThread (QNested s) s a)
offset_ offset' (Q q) =
Q (liftF (QOffset offset' q (rewriteThread (Proxy @s))))
exists_ :: ( IsSql92SelectSyntax select
, HasQBuilder select
, ProjectibleInSelectSyntax select a
, Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select)
=> Q select db s a
-> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool
exists_ q = QExpr (\tbl -> existsE (buildSqlQuery tbl q))
unique_ :: ( IsSql92SelectSyntax select
, HasQBuilder select
, ProjectibleInSelectSyntax select a
, Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select)
=> Q select db s a
-> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool
unique_ q = QExpr (\tbl -> uniqueE (buildSqlQuery tbl q))
distinct_ :: ( IsSql99ExpressionSyntax (Sql92SelectExpressionSyntax select)
, HasQBuilder select
, ProjectibleInSelectSyntax select a
, Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select) =>
Q select db s a
-> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool
distinct_ q = QExpr (\tbl -> distinctE (buildSqlQuery tbl q))
subquery_ ::
( IsSql92SelectSyntax select
, HasQBuilder select
, ProjectibleInSelectSyntax select (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)
, Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select) =>
Q select (db :: (* -> *) -> *) s (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)
-> QGenExpr ctxt (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a
subquery_ q =
QExpr (\tbl -> subqueryE (buildSqlQuery tbl q))
charLength_ :: ( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax )
=> QGenExpr context syntax s text -> QGenExpr context syntax s Int
charLength_ (QExpr s) = QExpr (charLengthE <$> s)
octetLength_ :: ( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax )
=> QGenExpr context syntax s text -> QGenExpr context syntax s Int
octetLength_ (QExpr s) = QExpr (octetLengthE <$> s)
bitLength_ ::
IsSql92ExpressionSyntax syntax =>
QGenExpr context syntax s SqlBitString -> QGenExpr context syntax s Int
bitLength_ (QExpr x) = QExpr (bitLengthE <$> x)
currentTimestamp_ :: IsSql92ExpressionSyntax syntax => QGenExpr ctxt syntax s LocalTime
currentTimestamp_ = QExpr (pure currentTimestampE)
position_ ::
( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax, Integral b ) =>
QExpr syntax s text -> QExpr syntax s text -> QExpr syntax s b
position_ (QExpr needle) (QExpr haystack) =
QExpr (liftA2 likeE needle haystack)
lower_ :: ( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax )
=> QGenExpr context syntax s text -> QGenExpr context syntax s text
lower_ (QExpr s) = QExpr (lowerE <$> s)
upper_ :: ( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax )
=> QGenExpr context syntax s text -> QGenExpr context syntax s text
upper_ (QExpr s) = QExpr (upperE <$> s)
trim_ :: ( IsSqlExpressionSyntaxStringType syntax text
, IsSql92ExpressionSyntax syntax )
=> QGenExpr context syntax s text -> QGenExpr context syntax s text
trim_ (QExpr s) = QExpr (trimE <$> s)
allE :: ( IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool) =>
[ QGenExpr context syntax s Bool ] -> QGenExpr context syntax s Bool
allE es = fromMaybe (QExpr (pure (valueE (sqlValueSyntax True)))) $
foldl (\expr x ->
Just $ maybe x (\e -> e &&. x) expr)
Nothing es
current_ :: IsSql92ExpressionSyntax expr
=> QField s ty -> QExpr expr s ty
current_ (QField False _ nm) = QExpr (pure (fieldE (unqualifiedField nm)))
current_ (QField True tbl nm) = QExpr (pure (fieldE (qualifiedField tbl nm)))
infix 4 <-.
class SqlUpdatable expr s lhs rhs | rhs -> expr, lhs -> s, rhs -> s, lhs s expr -> rhs, rhs -> lhs where
(<-.) :: forall fieldName.
IsSql92FieldNameSyntax fieldName
=> lhs
-> rhs
-> QAssignment fieldName expr s
instance SqlUpdatable expr s (QField s a) (QExpr expr s a) where
QField _ _ nm <-. QExpr expr =
QAssignment [(unqualifiedField nm, expr "t")]
instance Beamable tbl => SqlUpdatable expr s (tbl (QField s)) (tbl (QExpr expr s)) where
(<-.) :: forall fieldName.
IsSql92FieldNameSyntax fieldName
=> tbl (QField s) -> tbl (QExpr expr s)
-> QAssignment fieldName expr s
lhs <-. rhs =
QAssignment $
allBeamValues (\(Columnar' (Const assignments)) -> assignments) $
runIdentity $
zipBeamFieldsM (\(Columnar' (QField _ _ f) :: Columnar' (QField s) t) (Columnar' (QExpr e)) ->
pure (Columnar' (Const (unqualifiedField f, e "t")) :: Columnar' (Const (fieldName,expr)) t)) lhs rhs
instance Beamable tbl => SqlUpdatable expr s (tbl (Nullable (QField s))) (tbl (Nullable (QExpr expr s))) where
lhs <-. rhs =
let lhs' = changeBeamRep (\(Columnar' (QField q tblName fieldName') :: Columnar' (Nullable (QField s)) a) ->
Columnar' (QField q tblName fieldName') :: Columnar' (QField s) a) lhs
rhs' = changeBeamRep (\(Columnar' (QExpr e) :: Columnar' (Nullable (QExpr expr s)) a) ->
Columnar' (QExpr e) :: Columnar' (QExpr expr s) a) rhs
in lhs' <-. rhs'
union_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
union_ (Q a) (Q b) = Q (liftF (QUnion False a b (rewriteThread (Proxy @s))))
unionAll_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
unionAll_ (Q a) (Q b) = Q (liftF (QUnion True a b (rewriteThread (Proxy @s))))
intersect_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
intersect_ (Q a) (Q b) = Q (liftF (QIntersect False a b (rewriteThread (Proxy @s))))
intersectAll_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
intersectAll_ (Q a) (Q b) = Q (liftF (QIntersect True a b (rewriteThread (Proxy @s))))
except_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
except_ (Q a) (Q b) = Q (liftF (QExcept False a b (rewriteThread (Proxy @s))))
exceptAll_ :: forall select db s a.
( IsSql92SelectSyntax select
, Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a
, ProjectibleInSelectSyntax select a
, ThreadRewritable (QNested s) a)
=> Q select db (QNested s) a -> Q select db (QNested s) a
-> Q select db s (WithRewrittenThread (QNested s) s a)
exceptAll_ (Q a) (Q b) = Q (liftF (QExcept True a b (rewriteThread (Proxy @s))))
as_ :: forall a ctxt syntax s. QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a
as_ = id
type family HaskellLiteralForQExpr x = a
type instance HaskellLiteralForQExpr (QGenExpr context syntax s a) = a
type instance HaskellLiteralForQExpr (table (QGenExpr context syntax s)) = table Identity
type instance HaskellLiteralForQExpr (table (Nullable f)) = HaskellLiteralForQExpr_AddNullable (HaskellLiteralForQExpr (table f))
type family HaskellLiteralForQExpr_AddNullable x = a
type instance HaskellLiteralForQExpr_AddNullable (tbl f) = tbl (Nullable f)
type family QExprSyntax x where
QExprSyntax (QGenExpr ctxt syntax s a) = syntax
type SqlValableTable table expr =
( Beamable table
, IsSql92ExpressionSyntax expr
, FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax expr)) table )
class SqlValable a where
val_ :: HaskellLiteralForQExpr a -> a
instance (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) a, IsSql92ExpressionSyntax syntax) =>
SqlValable (QGenExpr ctxt syntax s a) where
val_ = QExpr . pure . valueE . sqlValueSyntax
instance ( Beamable table
, IsSql92ExpressionSyntax syntax
, FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) table ) =>
SqlValable (table (QGenExpr ctxt syntax s)) where
val_ tbl =
let fields :: table (WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))
fields = to (gWithConstrainedFields (Proxy @(HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))
(Proxy @(Rep (table Exposed))) (from tbl))
in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) x)) ->
Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields
instance ( Beamable table
, IsSql92ExpressionSyntax syntax
, FieldsFulfillConstraintNullable (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) table ) =>
SqlValable (table (Nullable (QGenExpr ctxt syntax s))) where
val_ tbl =
let fields :: table (Nullable (WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax))))
fields = to (gWithConstrainedFields (Proxy @(HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))
(Proxy @(Rep (table (Nullable Exposed)))) (from tbl))
in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) (Maybe x))) ->
Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields
default_ :: IsSql92ExpressionSyntax expr
=> QGenExpr ctxt expr s a
default_ = QExpr (pure defaultE)
noBounds_ :: QFrameBounds syntax
noBounds_ = QFrameBounds Nothing
fromBound_ :: IsSql2003WindowFrameBoundsSyntax syntax
=> QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax)
-> QFrameBounds syntax
fromBound_ start = bounds_ start Nothing
bounds_ :: IsSql2003WindowFrameBoundsSyntax syntax
=> QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax)
-> Maybe (QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax))
-> QFrameBounds syntax
bounds_ (QFrameBound start) end =
QFrameBounds . Just $
fromToBoundSyntax start
(fmap (\(QFrameBound end') -> end') end)
unbounded_ :: IsSql2003WindowFrameBoundSyntax syntax
=> QFrameBound syntax
unbounded_ = QFrameBound unboundedSyntax
nrows_ :: IsSql2003WindowFrameBoundSyntax syntax
=> Int -> QFrameBound syntax
nrows_ x = QFrameBound (nrowsBoundSyntax x)
noPartition_, noOrder_ :: Maybe (QOrd syntax s Int)
noOrder_ = Nothing
noPartition_ = Nothing
partitionBy_, orderPartitionBy_ :: partition -> Maybe partition
partitionBy_ = Just
orderPartitionBy_ = Just
frame_ :: ( IsSql2003ExpressionSyntax syntax
, SqlOrderable (Sql2003WindowFrameOrderingSyntax (Sql2003ExpressionWindowFrameSyntax syntax)) ordering
, Projectible syntax partition
, Sql2003ExpressionSanityCheck syntax )
=> Maybe partition
-> Maybe ordering
-> QFrameBounds (Sql2003WindowFrameBoundsSyntax (Sql2003ExpressionWindowFrameSyntax syntax))
-> QWindow (Sql2003ExpressionWindowFrameSyntax syntax) s
frame_ partition_ ordering_ (QFrameBounds bounds) =
QWindow $ \tblPfx ->
frameSyntax (case maybe [] (flip project tblPfx) partition_ of
[] -> Nothing
xs -> Just xs)
(case fmap makeSQLOrdering ordering_ of
Nothing -> Nothing
Just [] -> Nothing
Just xs -> Just (sequenceA xs tblPfx))
bounds
over_ :: IsSql2003ExpressionSyntax syntax =>
QAgg syntax s a -> QWindow (Sql2003ExpressionWindowFrameSyntax syntax) s -> QWindowExpr syntax s a
over_ (QExpr a) (QWindow frame) = QExpr (overE <$> a <*> frame)
withWindow_ :: forall window a s r select db.
( ProjectibleWithPredicate WindowFrameContext (Sql2003ExpressionWindowFrameSyntax (Sql92SelectExpressionSyntax select)) window
, Projectible (Sql92SelectExpressionSyntax select) r
, Projectible (Sql92SelectExpressionSyntax select) a
, ContextRewritable a
, ThreadRewritable (QNested s) (WithRewrittenContext a QValueContext)
, IsSql92SelectSyntax select)
=> (r -> window)
-> (r -> window -> a)
-> Q select db (QNested s) r
-> Q select db s (WithRewrittenThread (QNested s) s (WithRewrittenContext a QValueContext))
withWindow_ mkWindow mkProjection (Q windowOver)=
Q (liftF (QWindowOver mkWindow mkProjection windowOver (rewriteThread (Proxy @s) . rewriteContext (Proxy @QValueContext))))
class SqlOrderable syntax a | a -> syntax where
makeSQLOrdering :: a -> [ WithExprContext syntax ]
instance SqlOrderable syntax (QOrd syntax s a) where
makeSQLOrdering (QExpr x) = [x]
instance SqlOrderable syntax a => SqlOrderable syntax [a] where
makeSQLOrdering = concatMap makeSQLOrdering
instance ( SqlOrderable syntax a
, SqlOrderable syntax b ) => SqlOrderable syntax (a, b) where
makeSQLOrdering (a, b) = makeSQLOrdering a <> makeSQLOrdering b
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c ) => SqlOrderable syntax (a, b, c) where
makeSQLOrdering (a, b, c) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c
, SqlOrderable syntax d ) => SqlOrderable syntax (a, b, c, d) where
makeSQLOrdering (a, b, c, d) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c
, SqlOrderable syntax d
, SqlOrderable syntax e ) => SqlOrderable syntax (a, b, c, d, e) where
makeSQLOrdering (a, b, c, d, e) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <> makeSQLOrdering e
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c
, SqlOrderable syntax d
, SqlOrderable syntax e
, SqlOrderable syntax f ) => SqlOrderable syntax (a, b, c, d, e, f) where
makeSQLOrdering (a, b, c, d, e, f) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <> makeSQLOrdering e <> makeSQLOrdering f
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c
, SqlOrderable syntax d
, SqlOrderable syntax e
, SqlOrderable syntax f
, SqlOrderable syntax g ) => SqlOrderable syntax (a, b, c, d, e, f, g) where
makeSQLOrdering (a, b, c, d, e, f, g) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <>
makeSQLOrdering e <> makeSQLOrdering f <> makeSQLOrdering g
instance ( SqlOrderable syntax a
, SqlOrderable syntax b
, SqlOrderable syntax c
, SqlOrderable syntax d
, SqlOrderable syntax e
, SqlOrderable syntax f
, SqlOrderable syntax g
, SqlOrderable syntax h) => SqlOrderable syntax (a, b, c, d, e, f, g, h) where
makeSQLOrdering (a, b, c, d, e, f, g, h) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <>
makeSQLOrdering e <> makeSQLOrdering f <> makeSQLOrdering g <> makeSQLOrdering h
orderBy_ :: forall s a ordering syntax db.
( Projectible (Sql92SelectExpressionSyntax syntax) a
, SqlOrderable (Sql92SelectOrderingSyntax syntax) ordering
, ThreadRewritable (QNested s) a) =>
(a -> ordering) -> Q syntax db (QNested s) a -> Q syntax db s (WithRewrittenThread (QNested s) s a)
orderBy_ orderer (Q q) =
Q (liftF (QOrderBy (sequenceA . makeSQLOrdering . orderer) q (rewriteThread (Proxy @s))))
nullsFirst_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax syntax
=> QOrd syntax s a
-> QOrd syntax s a
nullsFirst_ (QExpr e) = QExpr (nullsFirstOrdering <$> e)
nullsLast_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax syntax
=> QOrd syntax s a
-> QOrd syntax s a
nullsLast_ (QExpr e) = QExpr (nullsLastOrdering <$> e)
asc_ :: forall syntax s a. IsSql92OrderingSyntax syntax
=> QExpr (Sql92OrderingExpressionSyntax syntax) s a
-> QOrd syntax s a
asc_ (QExpr e) = QExpr (ascOrdering <$> e)
desc_ :: forall syntax s a. IsSql92OrderingSyntax syntax
=> QExpr (Sql92OrderingExpressionSyntax syntax) s a
-> QOrd syntax s a
desc_ (QExpr e) = QExpr (descOrdering <$> e)
class SqlJustable a b | b -> a where
just_ :: a -> b
nothing_ :: b
instance ( IsSql92ExpressionSyntax syntax
, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull) =>
SqlJustable (QExpr syntax s a) (QExpr syntax s (Maybe a)) where
just_ (QExpr e) = QExpr e
nothing_ = QExpr (pure (valueE (sqlValueSyntax SqlNull)))
instance {-# OVERLAPPING #-} ( Table t
, IsSql92ExpressionSyntax syntax
, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull ) =>
SqlJustable (PrimaryKey t (QExpr syntax s)) (PrimaryKey t (Nullable (QExpr syntax s))) where
just_ = changeBeamRep (\(Columnar' q) -> Columnar' (just_ q))
nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' nothing_) (primaryKey (tblSkeleton :: TableSkeleton t))
instance {-# OVERLAPPING #-} ( Table t
, IsSql92ExpressionSyntax syntax
, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull ) =>
SqlJustable (t (QExpr syntax s)) (t (Nullable (QExpr syntax s))) where
just_ = changeBeamRep (\(Columnar' q) -> Columnar' (just_ q))
nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' nothing_) (tblSkeleton :: TableSkeleton t)
instance {-# OVERLAPPING #-} Table t => SqlJustable (PrimaryKey t Identity) (PrimaryKey t (Nullable Identity)) where
just_ = changeBeamRep (\(Columnar' q) -> Columnar' (Just q))
nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' Nothing) (primaryKey (tblSkeleton :: TableSkeleton t))
instance {-# OVERLAPPING #-} Table t => SqlJustable (t Identity) (t (Nullable Identity)) where
just_ = changeBeamRep (\(Columnar' q) -> Columnar' (Just q))
nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' Nothing) (tblSkeleton :: TableSkeleton t)
data QIfCond context expr s a = QIfCond (QGenExpr context expr s SqlBool) (QGenExpr context expr s a)
newtype QIfElse context expr s a = QIfElse (QGenExpr context expr s a)
then_ :: QGenExpr context expr s Bool -> QGenExpr context expr s a -> QIfCond context expr s a
then_ cond res = QIfCond (sqlBool_ cond) res
then_' :: QGenExpr context expr s SqlBool -> QGenExpr context expr s a -> QIfCond context expr s a
then_' cond res = QIfCond cond res
else_ :: QGenExpr context expr s a -> QIfElse context expr s a
else_ = QIfElse
if_ :: IsSql92ExpressionSyntax expr =>
[ QIfCond context expr s a ]
-> QIfElse context expr s a
-> QGenExpr context expr s a
if_ conds (QIfElse (QExpr elseExpr)) =
QExpr (\tbl -> caseE (map (\(QIfCond (QExpr cond) (QExpr res)) -> (cond tbl, res tbl)) conds) (elseExpr tbl))
coalesce_ :: IsSql92ExpressionSyntax expr
=> [ QGenExpr ctxt expr s (Maybe a) ] -> QGenExpr ctxt expr s a -> QGenExpr ctxt expr s a
coalesce_ qs (QExpr onNull) =
QExpr $ do
onNull' <- onNull
coalesceE . (<> [onNull']) <$> mapM (\(QExpr q) -> q) qs
fromMaybe_ :: IsSql92ExpressionSyntax expr
=> QGenExpr ctxt expr s a -> QGenExpr ctxt expr s (Maybe a) -> QGenExpr ctxt expr s a
fromMaybe_ onNull q = coalesce_ [q] onNull
class IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax a nonNullA s | a s -> syntax, a -> nonNullA, a -> s, nonNullA -> s where
isJust_ :: a -> QGenExpr ctxt syntax s Bool
isNothing_ :: a -> QGenExpr ctxt syntax s Bool
maybe_ :: QGenExpr ctxt syntax s y -> (nonNullA -> QGenExpr ctxt syntax s y) -> a -> QGenExpr ctxt syntax s y
instance IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax (QGenExpr ctxt syntax s (Maybe x)) (QGenExpr ctxt syntax s x) s where
isJust_ (QExpr x) = QExpr (isNotNullE <$> x)
isNothing_ (QExpr x) = QExpr (isNullE <$> x)
maybe_ (QExpr onNothing) onJust (QExpr e) =
let QExpr onJust' = onJust (QExpr e)
in QExpr (\tbl -> caseE [(isNotNullE (e tbl), onJust' tbl)] (onNothing tbl))
instance ( IsSql92ExpressionSyntax syntax
, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool
, Beamable t )
=> SqlDeconstructMaybe syntax (t (Nullable (QGenExpr ctxt syntax s))) (t (QGenExpr ctxt syntax s)) s where
isJust_ t = allE (allBeamValues (\(Columnar' e) -> isJust_ e) t)
isNothing_ t = allE (allBeamValues (\(Columnar' e) -> isNothing_ e) t)
maybe_ (QExpr onNothing) onJust tbl =
let QExpr onJust' = onJust (changeBeamRep (\(Columnar' (QExpr e)) -> Columnar' (QExpr e)) tbl)
QExpr cond = isJust_ tbl
in QExpr (\tblPfx -> caseE [(cond tblPfx, onJust' tblPfx)] (onNothing tblPfx))
infixl 3 <|>.
(<|>.) :: ( SqlJustable a (QGenExpr ctxt syntax s y)
, SqlDeconstructMaybe syntax (QGenExpr ctxt syntax s y) a s
)
=> QGenExpr ctxt syntax s y
-> QGenExpr ctxt syntax s y
-> QGenExpr ctxt syntax s y
l <|>. r = maybe_ r just_ l