Safe Haskell | None |
---|---|
Language | Haskell2010 |
Database.Beam.Query.Internal
- type ProjectibleInSelectSyntax syntax a = (IsSql92SelectSyntax syntax, Eq (Sql92SelectExpressionSyntax syntax), Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax) ~ Sql92SelectExpressionSyntax syntax, Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax, Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a, ProjectibleValue (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a)
- type TablePrefix = Text
- data QF select (db :: (* -> *) -> *) s next where
- QDistinct :: Projectible (Sql92SelectExpressionSyntax select) r => (r -> WithExprContext (Sql92SelectTableSetQuantifierSyntax (Sql92SelectSelectTableSyntax select))) -> QM select db s r -> (r -> next) -> QF select db s next
- QAll :: Beamable table => (TablePrefix -> Text -> Sql92SelectFromSyntax select) -> TableSettings table -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select))) -> ((Text, table (QExpr (Sql92SelectExpressionSyntax select) s)) -> next) -> QF select db s next
- QArbitraryJoin :: Projectible (Sql92SelectExpressionSyntax select) r => QM select db (QNested s) r -> (Sql92SelectFromSyntax select -> Sql92SelectFromSyntax select -> Maybe (Sql92FromExpressionSyntax (Sql92SelectFromSyntax select)) -> Sql92SelectFromSyntax select) -> (r -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select))) -> (r -> next) -> QF select db s next
- QTwoWayJoin :: (Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b) => QM select db (QNested s) a -> QM select db (QNested s) b -> (Sql92SelectFromSyntax select -> Sql92SelectFromSyntax select -> Maybe (Sql92FromExpressionSyntax (Sql92SelectFromSyntax select)) -> Sql92SelectFromSyntax select) -> ((a, b) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select))) -> ((a, b) -> next) -> QF select db s next
- QSubSelect :: Projectible (Sql92SelectExpressionSyntax select) r => QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QGuard :: WithExprContext (Sql92SelectExpressionSyntax select) -> next -> QF select db s next
- QLimit :: Projectible (Sql92SelectExpressionSyntax select) r => Integer -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QOffset :: Projectible (Sql92SelectExpressionSyntax select) r => Integer -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QUnion :: Projectible (Sql92SelectExpressionSyntax select) r => Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QIntersect :: Projectible (Sql92SelectExpressionSyntax select) r => Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QExcept :: Projectible (Sql92SelectExpressionSyntax select) r => Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QOrderBy :: Projectible (Sql92SelectExpressionSyntax select) r => (r -> WithExprContext [Sql92SelectOrderingSyntax select]) -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- QWindowOver :: (ProjectibleWithPredicate WindowFrameContext (Sql2003ExpressionWindowFrameSyntax (Sql92SelectExpressionSyntax select)) window, Projectible (Sql92SelectExpressionSyntax select) r, Projectible (Sql92SelectExpressionSyntax select) a) => (r -> window) -> (r -> window -> a) -> QM select db (QNested s) r -> (a -> next) -> QF select db s next
- QAggregate :: (Projectible (Sql92SelectExpressionSyntax select) grouping, Projectible (Sql92SelectExpressionSyntax select) a) => (a -> TablePrefix -> (Maybe (Sql92SelectGroupingSyntax select), grouping)) -> QM select db (QNested s) a -> (grouping -> next) -> QF select db s next
- QForceSelect :: Projectible (Sql92SelectExpressionSyntax select) r => (r -> Sql92SelectSelectTableSyntax select -> [Sql92SelectOrderingSyntax select] -> Maybe Integer -> Maybe Integer -> select) -> QM select db (QNested s) r -> (r -> next) -> QF select db s next
- type QM select db s = F (QF select db s)
- newtype Q syntax (db :: (* -> *) -> *) s a = Q {}
- data QInternal
- data QNested s
- data QField s ty = QField {}
- newtype QAssignment fieldName expr s = QAssignment [(fieldName, expr)]
- data QAggregateContext
- data QGroupingContext
- data QValueContext
- data QOrderingContext
- data QWindowingContext
- data QWindowFrameContext
- newtype QGenExpr context syntax s t = QExpr (TablePrefix -> syntax)
- type WithExprContext a = TablePrefix -> a
- type QExpr = QGenExpr QValueContext
- type QAgg = QGenExpr QAggregateContext
- type QOrd = QGenExpr QOrderingContext
- type QWindowExpr = QGenExpr QWindowingContext
- type QWindowFrame = QGenExpr QWindowFrameContext
- type QGroupExpr = QGenExpr QGroupingContext
- newtype QWindow syntax s = QWindow (WithExprContext syntax)
- newtype QFrameBounds syntax = QFrameBounds (Maybe syntax)
- newtype QFrameBound syntax = QFrameBound syntax
- qBinOpE :: forall syntax context s a b c. IsSql92ExpressionSyntax syntax => (syntax -> syntax -> syntax) -> QGenExpr context syntax s a -> QGenExpr context syntax s b -> QGenExpr context syntax s c
- unsafeRetype :: QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a'
- data Aggregation syntax s a
- = GroupAgg syntax
- | ProjectAgg syntax
- class Typeable context => AggregateContext context
- type family ContextName a :: Symbol
- type family IsAggregateContext a :: Constraint where ...
- type family AggregateContextSuggestion a :: ErrorMessage where ...
- class Typeable context => ValueContext context
- class Typeable context => WindowFrameContext context
- type family IsWindowFrameContext a :: Constraint where ...
- class AnyType a
- type family IsValueContext a :: Constraint where ...
- type family ValueContextSuggestion a :: ErrorMessage where ...
- type Projectible = ProjectibleWithPredicate AnyType
- type ProjectibleValue = ProjectibleWithPredicate ValueContext
- class ThreadRewritable (s :: *) (a :: *) | a -> s where
- type WithRewrittenThread s (s' :: *) a :: *
- class ContextRewritable a where
- type WithRewrittenContext a ctxt :: *
- class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) syntax a | a -> syntax where
- project :: Projectible syntax a => a -> WithExprContext [syntax]
- reproject :: (IsSql92ExpressionSyntax syntax, Projectible syntax a) => (Int -> syntax) -> a -> a
Documentation
type ProjectibleInSelectSyntax syntax a = (IsSql92SelectSyntax syntax, Eq (Sql92SelectExpressionSyntax syntax), Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax) ~ Sql92SelectExpressionSyntax syntax, Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax, Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a, ProjectibleValue (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a) Source #
type TablePrefix = Text Source #
data QF select (db :: (* -> *) -> *) s next where Source #
Constructors
newtype Q syntax (db :: (* -> *) -> *) s a Source #
The type of queries over the database db
returning results of type a
.
The s
argument is a threading argument meant to restrict cross-usage of
QExpr
s. syntax
represents the SQL syntax that this query is building.
Constructors
QField | |
Fields
|
Instances
Beamable t => ProjectibleWithPredicate AnyType Text (t (Nullable (QField s))) Source # | |
Beamable t => ProjectibleWithPredicate AnyType Text (t (QField s)) Source # | |
ProjectibleWithPredicate AnyType Text (QField s a) Source # | |
Eq (QField s ty) Source # | |
Ord (QField s ty) Source # | |
Show (QField s ty) Source # | |
newtype QAssignment fieldName expr s Source #
Constructors
QAssignment [(fieldName, expr)] |
Instances
(Eq expr, Eq fieldName) => Eq (QAssignment fieldName expr s) Source # | |
(Ord expr, Ord fieldName) => Ord (QAssignment fieldName expr s) Source # | |
(Show expr, Show fieldName) => Show (QAssignment fieldName expr s) Source # | |
Semigroup (QAssignment fieldName expr s) Source # | |
Monoid (QAssignment fieldName expr s) Source # | |
QGenExpr type
data QAggregateContext Source #
Instances
data QGroupingContext Source #
Instances
Beamable tbl => QGroupable (tbl (QExpr expr s)) (tbl (QGroupExpr expr s)) Source # |
|
QGroupable (QExpr expr s a) (QGroupExpr expr s a) Source # |
|
type ContextName QGroupingContext Source # | |
data QValueContext Source #
Instances
(Table t, IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull) => SqlJustable (t (QExpr syntax s)) (t (Nullable (QExpr syntax s))) Source # | |
Beamable tbl => QGroupable (tbl (QExpr expr s)) (tbl (QGroupExpr expr s)) Source # |
|
(Table t, IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull) => SqlJustable (PrimaryKey t (QExpr syntax s)) (PrimaryKey t (Nullable (QExpr syntax s))) Source # | |
(IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull) => SqlJustable (QExpr syntax s a) (QExpr syntax s (Maybe a)) Source # | |
QGroupable (QExpr expr s a) (QGroupExpr expr s a) Source # |
|
type ContextName QValueContext Source # | |
data QOrderingContext Source #
Instances
SqlOrderable syntax (QOrd syntax s a) Source # | |
type ContextName QOrderingContext Source # | |
data QWindowingContext Source #
Instances
data QWindowFrameContext Source #
Instances
newtype QGenExpr context syntax s t Source #
The type of lifted beam expressions that will yield the haskell type t
.
context
is a type-level representation of the types of expressions this
can contain. For example, QAggregateContext
represents expressions that
may contain aggregates, and QWindowingContext
represents expressions that
may contain OVER
.
syntax
is the expression syntax being built (usually a type that
implements IsSql92ExpressionSyntax
at least, but not always).
s
is a state threading parameter that prevents QExpr
s from incompatible
sources to be combined. For example, this is used to prevent monadic joins
from depending on the result of previous joins (so-called LATERAL
joins).
Constructors
QExpr (TablePrefix -> syntax) |
Instances
type WithExprContext a = TablePrefix -> a Source #
type QAgg = QGenExpr QAggregateContext Source #
type QOrd = QGenExpr QOrderingContext Source #
type QWindowExpr = QGenExpr QWindowingContext Source #
type QGroupExpr = QGenExpr QGroupingContext Source #
newtype QWindow syntax s Source #
Constructors
QWindow (WithExprContext syntax) |
Instances
ProjectibleWithPredicate WindowFrameContext syntax (QWindow syntax s) Source # | |
newtype QFrameBounds syntax Source #
Constructors
QFrameBounds (Maybe syntax) |
newtype QFrameBound syntax Source #
Constructors
QFrameBound syntax |
qBinOpE :: forall syntax context s a b c. IsSql92ExpressionSyntax syntax => (syntax -> syntax -> syntax) -> QGenExpr context syntax s a -> QGenExpr context syntax s b -> QGenExpr context syntax s c Source #
unsafeRetype :: QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a' Source #
Aggregations
data Aggregation syntax s a Source #
Constructors
GroupAgg syntax | |
ProjectAgg syntax |
Sql Projections
class Typeable context => AggregateContext context Source #
Typeclass for all haskell data types that can be used to create a projection in a SQL select statement. This includes all tables as well as all tuple classes. Projections are only defined on tuples up to size 5. If you need more, follow the implementations here.
Instances
(IsAggregateContext a, Typeable * a) => AggregateContext a Source # | |
type family ContextName a :: Symbol Source #
Instances
type ContextName QWindowFrameContext Source # | |
type ContextName QWindowingContext Source # | |
type ContextName QOrderingContext Source # | |
type ContextName QValueContext Source # | |
type ContextName QGroupingContext Source # | |
type ContextName QAggregateContext Source # | |
type family IsAggregateContext a :: Constraint where ... Source #
Equations
IsAggregateContext QAggregateContext = () | |
IsAggregateContext QGroupingContext = () | |
IsAggregateContext a = TypeError ((Text "Non-aggregate expression where aggregate expected." :$$: ((Text "Got " :<>: Text (ContextName a)) :<>: Text ". Expected an aggregate or a grouping")) :$$: AggregateContextSuggestion a) |
type family AggregateContextSuggestion a :: ErrorMessage where ... Source #
Equations
AggregateContextSuggestion QValueContext = Text "Perhaps you forgot to wrap a value expression with 'group_'" | |
AggregateContextSuggestion QWindowingContext = Text "Perhaps you meant to use 'window_' instead of 'aggregate_'" | |
AggregateContextSuggestion QOrderingContext = Text "You cannot use an ordering in an aggregate" | |
AggregateContextSuggestion b = Text "" |
class Typeable context => ValueContext context Source #
Instances
(IsValueContext a, Typeable * a, (~) * a QValueContext) => ValueContext a Source # | |
class Typeable context => WindowFrameContext context Source #
Instances
(Typeable * context, IsWindowFrameContext context, (~) * context QWindowFrameContext) => WindowFrameContext context Source # | |
ProjectibleWithPredicate WindowFrameContext syntax (QWindow syntax s) Source # | |
type family IsWindowFrameContext a :: Constraint where ... Source #
Equations
IsWindowFrameContext QWindowFrameContext = () | |
IsWindowFrameContext a = TypeError (Text "Expected window frame." :$$: ((Text "Got " :<>: Text (ContextName a)) :<>: Text ". Expected a window frame")) |
type family IsValueContext a :: Constraint where ... Source #
Equations
IsValueContext QValueContext = () | |
IsValueContext a = TypeError ((Text "Non-scalar context in projection" :$$: ((Text "Got " :<>: Text (ContextName a)) :<>: Text ". Expected a value")) :$$: ValueContextSuggestion a) |
type family ValueContextSuggestion a :: ErrorMessage where ... Source #
Equations
ValueContextSuggestion QWindowingContext = Text "Use 'window_' to projecct aggregate expressions to the value level" | |
ValueContextSuggestion QOrderingContext = Text "An ordering context cannot be used in a projection. Try removing the 'asc_' or 'desc_', or use 'orderBy_' to sort the result set" | |
ValueContextSuggestion QAggregateContext = Text "Aggregate functions and groupings cannot be contained in value expressions." :$$: Text "Use 'aggregate_' to compute aggregations at the value level." | |
ValueContextSuggestion QGroupingContext = ValueContextSuggestion QAggregateContext | |
ValueContextSuggestion _ = Text "" |
class ThreadRewritable (s :: *) (a :: *) | a -> s where Source #
Minimal complete definition
Associated Types
type WithRewrittenThread s (s' :: *) a :: * Source #
Methods
rewriteThread :: Proxy s' -> a -> WithRewrittenThread s s' a Source #
Instances
class ContextRewritable a where Source #
Minimal complete definition
Associated Types
type WithRewrittenContext a ctxt :: * Source #
Methods
rewriteContext :: Proxy ctxt -> a -> WithRewrittenContext a ctxt Source #
Instances
class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) syntax a | a -> syntax where Source #
Minimal complete definition
Methods
project' :: Monad m => Proxy contextPredicate -> (forall context. contextPredicate context => Proxy context -> WithExprContext syntax -> m (WithExprContext syntax)) -> a -> m a Source #
Instances
ProjectibleWithPredicate contextPredicate syntax a => ProjectibleWithPredicate contextPredicate syntax [a] Source # | |
(Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate syntax (t (Nullable (QGenExpr context syntax s))) Source # | |
(Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate syntax (t (QGenExpr context syntax s)) Source # | |
Beamable t => ProjectibleWithPredicate AnyType Text (t (Nullable (QField s))) Source # | |
Beamable t => ProjectibleWithPredicate AnyType Text (t (QField s)) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b) => ProjectibleWithPredicate contextPredicate syntax (a, b) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, KnownNat n) => ProjectibleWithPredicate contextPredicate syntax (Vector n a) Source # | |
ProjectibleWithPredicate AnyType Text (QField s a) Source # | |
ProjectibleWithPredicate WindowFrameContext syntax (QWindow syntax s) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c) => ProjectibleWithPredicate contextPredicate syntax (a, b, c) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c, ProjectibleWithPredicate contextPredicate syntax d) => ProjectibleWithPredicate contextPredicate syntax (a, b, c, d) Source # | |
contextPredicate context => ProjectibleWithPredicate contextPredicate syntax (QGenExpr context syntax s a) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c, ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e) => ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c, ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f) => ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c, ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f, ProjectibleWithPredicate contextPredicate syntax g) => ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f, g) Source # | |
(ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c, ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f, ProjectibleWithPredicate contextPredicate syntax g, ProjectibleWithPredicate contextPredicate syntax h) => ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f, g, h) Source # | |
project :: Projectible syntax a => a -> WithExprContext [syntax] Source #
reproject :: (IsSql92ExpressionSyntax syntax, Projectible syntax a) => (Int -> syntax) -> a -> a Source #