beam-core 0.6.0.0 → 0.7.0.0

raw patch · 27 files changed

+1475/−375 lines, 27 filesdep +taggeddep ~freePVP ok

version bump matches the API change (PVP)

Dependencies added: tagged

Dependency ranges changed: free

API changes (from Hackage documentation)

Files

• ChangeLog.md +126/−0
• Database/Beam.hs +1/−2
• Database/Beam/Backend/SQL.hs +2/−5
• Database/Beam/Backend/SQL/AST.hs +152/−14
• Database/Beam/Backend/SQL/BeamExtensions.hs +32/−6
• Database/Beam/Backend/SQL/Builder.hs +3/−0
• Database/Beam/Backend/SQL/SQL92.hs +39/−2
• Database/Beam/Backend/SQL/Types.hs +1/−1
• Database/Beam/Backend/Types.hs +6/−25
• Database/Beam/Backend/URI.hs +27/−5
• Database/Beam/Query.hs +100/−42
• Database/Beam/Query/Aggregate.hs +28/−13
• Database/Beam/Query/Combinators.hs +156/−44
• Database/Beam/Query/CustomSQL.hs +31/−14
• Database/Beam/Query/Extensions.hs +2/−2
• Database/Beam/Query/Internal.hs +28/−5
• Database/Beam/Query/Operator.hs +40/−38
• Database/Beam/Query/Ord.hs +261/−30
• Database/Beam/Query/Relationships.hs +8/−6
• Database/Beam/Query/SQL92.hs +94/−61
• Database/Beam/Query/Types.hs +22/−1
• Database/Beam/Schema/Lenses.hs +12/−5
• Database/Beam/Schema/Tables.hs +40/−6
• LICENSE +1/−1
• beam-core.cabal +5/−4
• test/Database/Beam/Test/SQL.hs +253/−30
• test/Database/Beam/Test/Schema.hs +5/−13

@@ -1,3 +1,129 @@+# 0.7.0.0++## Weaker functional dependencies on `MonadBeam`++The functional dependency on `MonadBeam` is now just `m -> syntax be+handle`. This allows us to define `MonadBeam` instances atop monad transformers+(although we don't have any yet!).++## Correct boolean handling++Previous versions of beam used the SQL `=` operator to compare potentially+`NULL` values. This is incorrect, as `NULL = NULL => UNKNOWN` in ANSI-compliant+implementations. Beam has changed its emitted SQL to produce proper comparisons,+but this can dramatically affect performance in some backends. Particularly,+proper JOIN index usage in Postgres requires an exact match on an equality+constructor, which may not be what you get when using the proper boolean+handling.++If you are okay using SQL null handling, you can use the new `==?.` and `/=?.`+operators which produce an expression with type `SqlBool` instead. `SqlBool` is+a type that can represent the SQL `BOOL` type in all its gritty glory. Note+however, that these operators do not compare for haskell equality, only SQL+equality, so please understand what that means before using them.++Correspondingly, many functions that took `Bool` expressions now have+corresponding versions that take `SqlBool`. For example, to use `guard_` with a+`SqlBool` expression use `guard_'` (note the prime).++(Note: I don't really like that we have to do this, but this is the only way+unless we introspect user expressions. Beam's philosophy is to be as direct as+possible. The `==.` operator corresponds to haskell `==`, and so produces the+boolean we would expect as Haskell programmers. The `==?.` operator is a new+operator that users must explicitly opt in to. Both produce the most direct code+possible on each backend.)++## Aggregations return `Maybe` types++In previous versions of beam, aggregations such as `avg_`, `sum_`, etc+returned the an expression of the same type as its inputs. However,+this does not match standard SQL behavior, where these aggregates can+return NULL if no rows are selected for the aggregation. This breaks+older code, but is more correct. To restore the older behavior, use+the `fromMaybe_` function to supply a default value.++## Miscellaneous name changes++The `Database.Beam.Query.lookup` function was renamed to `lookup_` to+avoid overlap with the `Prelude` function of the same name.++## Reintroduce explicit backends to `Database` class++Some database entites only work on particular backends. For example,+beam-postgres extension support only works in beam-postgres. The lack+of a backend parameter on the `Database` type class essentially+mandated that every database entity worked on every backend. By+introducing a backend parameter to `Database`, we allow the user to+restrict which backends a database can work on.++The old behavior is still easily recovered. Whereas before you'd write++```haskell+instance Database MyDatabase+```++Now write++```haskell+instance Database be MyDatabase+```++## Require backends to explicitly declare types that can be compared for equality++Beam previously allowed any two types to be compared for SQL+equality. This is no longer the case. Rather, only types that are+instances of `HasSqlEqualityCheck` for the given expression syntax can+be checked for equality. Correspondingly, only types that are+instances of `HasSqlQuantifiedEqualityCheck` can be checked for+quantified equality.++This change is somewhat invasive, as the relationship and join+operators depend on the ability to check primary keys for+equality. You may have to add appropriate class constraints to your+queries. In order to assert that a table can be compared for equality,+you can use the `HasTableEquality` constraint synonym.++### For Backends++Backend implementors should establish instances of+`HasSqlEqualityCheck` and `HasSqlQuantifiedEqualityCheck` for every+type that can be compared in their syntax. You may choose to implement+a custom equality and inequality operator. Alternatively, you can+leave the instances empty to use the defaults, which match the old+behavior.++## Properly deal with NULL values in equality++Previous versions of Beam would use SQL `=` and `<>` operators to+compare potentially `NULL` values. However, `NULL = NULL` is always+false, according to the SQL standard, so this behavior is incorrect.++Now, Beam will generate a `CASE .. WHEN ..` statement to explicitly+handle mismatching `NULL`s. This is the 'expected' behavior from the+Haskell perspective, but does not match what one may expect in+SQL. Note that it is always better to explicitly handle `NULL`s using+`maybe_`, and beam recommends this approach in robust code.++## Remove `Auto` for fields with default values++`Auto` was a convenience type for dealing with tables where some+columns have been given a default value. `Auto` worked well enough but+it was a very leaky abstraction. Moreover, it was+unnecessary. Everything you can do with `Auto` can be done more safely+with `default_`.++For example, instead of using++```haskell+insertValues [ Table1 (Auto Nothing) "Field Value" "Another Field Value" ]+```++use++```haskell+insertExpressions [ Table1 default_ (val_ "Field Value") (val_ "Another Field Value") ]+```+ # 0.6.0.0  * Mostly complete SQL92, SQL99 support

@@ -2,7 +2,7 @@ -- | Top-level Beam module. This module re-exports all the symbols --   necessary for most common user operations. -----   The most interesting modules are 'Database.Beam.Schema' and 'Database.Beam.Query'.+--   The most interesting modules are "Database.Beam.Schema" and "Database.Beam.Query". -- --   This is mainly reference documentation. Most users will want to consult the --   [manual](https://tathougies.github.io/beam).@@ -12,7 +12,6 @@      ( module Database.Beam.Query      , module Database.Beam.Schema      , MonadBeam(withDatabase, withDatabaseDebug)-     , Auto(..)      , FromBackendRow(..)         -- * Re-exports

@@ -15,9 +15,6 @@  -- | A class that ties together a Sql syntax, backend, handle, and monad type. -----   Functional dependencies mean that only the backend type or the handle need---   to be specified.--- --   Intuitively, this allows you to write code that performs database commands --   without having to know the underlying API. As long as you have an --   appropriate handle from a database library that Beam can use, you can use@@ -25,7 +22,7 @@ -- --   Provided here is a low-level interface. Most often, you'll only need the --   'withDatabase' and 'withDatabaseDebug' function. The 'run*' functions are---   wrapped by the appropriate functions in 'Database.Beam.Query'.+--   wrapped by the appropriate functions in "Database.Beam.Query". -- --   This interface is very high-level and isn't meant to expose the full power --   of the underlying database. Namely, it only supports simple data retrieval@@ -33,7 +30,7 @@ --   are supported in individual backends. See the documentation of those --   backends for more details. class (BeamBackend be, Monad m, MonadIO m, Sql92SanityCheck syntax) =>-  MonadBeam syntax be handle m | m -> syntax be handle, be -> m, handle -> m where+  MonadBeam syntax be handle m | m -> syntax be handle where    {-# MINIMAL withDatabaseDebug, runReturningMany #-} 

@@ -1,15 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} -- | This module implements an AST type for SQL92. It allows us to realize---   the call structure of the builders defined in 'Database.Beam.Backend.SQL92'+--   the call structure of the builders defined in "Database.Beam.Backend.SQL.SQL92" module Database.Beam.Backend.SQL.AST where  import Prelude hiding (Ordering)  import Database.Beam.Backend.SQL.SQL92 import Database.Beam.Backend.SQL.SQL99+import Database.Beam.Backend.SQL.SQL2003 import Database.Beam.Backend.SQL.Types-import Database.Beam.Backend.Types  import Data.Text (Text) import Data.ByteString (ByteString)@@ -161,13 +161,15 @@   deriving (Show, Eq)  data DataType-  = DataTypeChar Bool {- Varying -} (Maybe Int)-  | DataTypeNationalChar Bool (Maybe Int)-  | DataTypeBit Bool (Maybe Int)-  | DataTypeNumeric Int (Maybe Int)+  = DataTypeChar Bool {- Varying -} (Maybe Word) (Maybe Text)+  | DataTypeNationalChar Bool (Maybe Word)+  | DataTypeBit Bool (Maybe Word)+  | DataTypeNumeric (Maybe (Word, Maybe Word))+  | DataTypeDecimal (Maybe (Word, Maybe Word))   | DataTypeInteger   | DataTypeSmallInt-  | DataTypeFloat (Maybe Int)+  | DataTypeBigInt+  | DataTypeFloat (Maybe Word)   | DataTypeReal   | DataTypeDoublePrecision   | DataTypeDate@@ -175,8 +177,47 @@   | DataTypeTimeStamp (Maybe Word) Bool   | DataTypeInterval ExtractField   | DataTypeIntervalFromTo ExtractField ExtractField+  | DataTypeBoolean++  | DataTypeBinaryLargeObject+  | DataTypeCharacterLargeObject++  | DataTypeArray DataType Int+  | DataTypeRow [ (Text, DataType) ]++  | DataTypeDomain Text   deriving (Show, Eq) +instance IsSql92DataTypeSyntax DataType where+  domainType = DataTypeDomain+  charType = DataTypeChar False+  varCharType = DataTypeChar True+  nationalCharType = DataTypeNationalChar False+  nationalVarCharType = DataTypeNationalChar True+  bitType = DataTypeBit False+  varBitType = DataTypeBit True+  numericType = DataTypeNumeric+  decimalType = DataTypeDecimal+  intType = DataTypeInteger+  smallIntType = DataTypeSmallInt+  floatType = DataTypeFloat+  doubleType = DataTypeDoublePrecision+  realType = DataTypeReal++  dateType = DataTypeDate+  timeType = DataTypeTime+  timestampType = DataTypeTimeStamp++instance IsSql99DataTypeSyntax DataType where+  characterLargeObjectType = DataTypeCharacterLargeObject+  binaryLargeObjectType = DataTypeCharacterLargeObject+  booleanType = DataTypeBoolean+  arrayType = DataTypeArray+  rowType = DataTypeRow++instance IsSql2008BigIntDataTypeSyntax DataType where+  bigIntType = DataTypeBigInt+ data SetQuantifier   = SetQuantifierAll | SetQuantifierDistinct   deriving (Show, Eq)@@ -219,6 +260,9 @@   | ExpressionOctetLength Expression   | ExpressionBitLength Expression   | ExpressionAbs Expression+  | ExpressionLower Expression+  | ExpressionUpper Expression+  | ExpressionTrim Expression    | ExpressionFunctionCall Expression [ Expression ]   | ExpressionInstanceField Expression Text@@ -226,12 +270,15 @@    | ExpressionCountAll   | ExpressionAgg Text (Maybe SetQuantifier) [ Expression ]+  | ExpressionBuiltinFunction Text [ Expression ]    | ExpressionSubquery Select   | ExpressionUnique Select   | ExpressionDistinct Select   | ExpressionExists Select +  | ExpressionOver Expression WindowFrame+   | ExpressionCurrentTimestamp   deriving (Show, Eq) @@ -291,6 +338,9 @@   octetLengthE = ExpressionOctetLength   bitLengthE = ExpressionBitLength   absE = ExpressionAbs+  lowerE = ExpressionLower+  upperE = ExpressionUpper+  trimE = ExpressionTrim    subqueryE = ExpressionSubquery   uniqueE = ExpressionUnique@@ -313,11 +363,65 @@    countAllE = ExpressionCountAll   countE q = ExpressionAgg "COUNT" q . pure-  sumE q = ExpressionAgg "SUM" q . pure-  minE q = ExpressionAgg "MIN" q . pure-  maxE q = ExpressionAgg "MAX" q . pure-  avgE q = ExpressionAgg "AVG" q . pure+  sumE q   = ExpressionAgg "SUM" q . pure+  minE q   = ExpressionAgg "MIN" q . pure+  maxE q   = ExpressionAgg "MAX" q . pure+  avgE q   = ExpressionAgg "AVG" q . pure +instance IsSql99AggregationExpressionSyntax Expression where+  everyE q = ExpressionAgg "EVERY" q . pure+  someE q  = ExpressionAgg "SOME" q . pure+  anyE q   = ExpressionAgg "ANY" q . pure++instance IsSql2003EnhancedNumericFunctionsExpressionSyntax Expression where+  lnE    = ExpressionBuiltinFunction "LN" . pure+  expE   = ExpressionBuiltinFunction "EXP" . pure+  sqrtE  = ExpressionBuiltinFunction "SQRT" . pure+  ceilE  = ExpressionBuiltinFunction "CEIL" . pure+  floorE = ExpressionBuiltinFunction "FLOOR" . pure+  powerE a b = ExpressionBuiltinFunction "POWER" [a, b]++instance IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax Expression where+  stddevPopE q  = ExpressionAgg "STDDEV_POP" q . pure+  stddevSampE q = ExpressionAgg "STDDEV_SAMP" q . pure+  varPopE q     = ExpressionAgg "VAR_POP" q . pure+  varSampE q    = ExpressionAgg "VAR_SAMP" q . pure++  covarPopE q a b      = ExpressionAgg "COVAR_POP" q [a, b]+  covarSampE q a b     = ExpressionAgg "COVAR_SAMP" q [a, b]+  corrE q a b          = ExpressionAgg "CORR" q [a, b]+  regrSlopeE q a b     = ExpressionAgg "REGR_SLOPE" q [a, b]+  regrInterceptE q a b = ExpressionAgg "REGR_INTERCEPT" q [a, b]+  regrCountE q a b     = ExpressionAgg "REGR_COUNT" q [a, b]+  regrRSquaredE q a b  = ExpressionAgg "REGR_R2" q [a, b]+  regrAvgXE q a b      = ExpressionAgg "REGR_AVGX" q [a, b]+  regrAvgYE q a b      = ExpressionAgg "REGR_AVGY" q [a, b]+  regrSXXE q a b       = ExpressionAgg "REGR_SXX" q [a, b]+  regrSXYE q a b       = ExpressionAgg "REGR_SXY" q [a, b]+  regrSYYE q a b       = ExpressionAgg "REGR_SYY" q [a, b]++instance IsSql2003NtileExpressionSyntax Expression where+  ntileE = ExpressionAgg "NTILE" Nothing . pure++instance IsSql2003LeadAndLagExpressionSyntax Expression where+  leadE x Nothing Nothing   = ExpressionAgg "LEAD" Nothing [x]+  leadE x (Just y) Nothing  = ExpressionAgg "LEAD" Nothing [x, y]+  leadE x (Just y) (Just z) = ExpressionAgg "LEAD" Nothing [x, y, z]+  leadE x Nothing (Just z)  = ExpressionAgg "LEAD" Nothing [x, ExpressionValue (Value (1 :: Int)), z]++  lagE x Nothing Nothing  = ExpressionAgg "LAG" Nothing [x]+  lagE x (Just y) Nothing = ExpressionAgg "LAG" Nothing [x, y]+  lagE x (Just y) (Just z) = ExpressionAgg "LAG" Nothing [x, y, z]+  lagE x Nothing (Just z)  = ExpressionAgg "LAG" Nothing [x, ExpressionValue (Value (1 :: Int)), z]++instance IsSql2003NthValueExpressionSyntax Expression where+  nthValueE a b = ExpressionAgg "NTH_VALUE" Nothing [a, b]++instance IsSql2003ExpressionSyntax Expression where+  type Sql2003ExpressionWindowFrameSyntax Expression = WindowFrame++  overE = ExpressionOver+ newtype Projection   = ProjExprs [ (Expression, Maybe Text ) ]   deriving (Show, Eq)@@ -401,9 +505,6 @@   sqlValueSyntax (Just x) = sqlValueSyntax x   sqlValueSyntax Nothing = sqlValueSyntax SqlNull -instance HasSqlValueSyntax Value (Maybe x) => HasSqlValueSyntax Value (Auto x) where-  sqlValueSyntax (Auto x) = sqlValueSyntax x- instance Eq Value where   Value a == Value b =     case cast a of@@ -415,3 +516,40 @@     ("Value " ++ ).     showsPrec (app_prec + 1) a     where app_prec = 10++-- Window functions++data WindowFrame+  = WindowFrame+  { windowFramePartitions :: Maybe [Expression]+  , windowFrameOrdering   ::  Maybe [Ordering]+  , windowFrameBounds     :: Maybe WindowFrameBounds+  } deriving (Show, Eq)++instance IsSql2003WindowFrameSyntax WindowFrame where+  type Sql2003WindowFrameExpressionSyntax WindowFrame = Expression+  type Sql2003WindowFrameOrderingSyntax WindowFrame = Ordering+  type Sql2003WindowFrameBoundsSyntax WindowFrame = WindowFrameBounds++  frameSyntax = WindowFrame++data WindowFrameBounds+  = WindowFrameBounds+  { boundsFrom :: WindowFrameBound+  , boundsTo   :: Maybe WindowFrameBound+  } deriving (Show, Eq)++instance IsSql2003WindowFrameBoundsSyntax WindowFrameBounds where+  type Sql2003WindowFrameBoundsBoundSyntax WindowFrameBounds = WindowFrameBound++  fromToBoundSyntax = WindowFrameBounds++data WindowFrameBound+  = WindowFrameUnbounded+  | WindowFrameBoundNRows Int+  deriving (Show, Eq)++instance IsSql2003WindowFrameBoundSyntax WindowFrameBound where+  unboundedSyntax = WindowFrameUnbounded+  nrowsBoundSyntax = WindowFrameBoundNRows+

@@ -1,5 +1,18 @@-module Database.Beam.Backend.SQL.BeamExtensions where+-- | Some functionality is useful enough to be provided across backends, but is+-- not standardized. For example, many RDBMS systems provide ways of fetching+-- auto-incrementing or defaulting fields on INSERT or UPDATE.+--+-- Beam provides type classes that some backends instantiate that provide this+-- support. This uses direct means on sufficiently advanced backends and is+-- emulated on others.+module Database.Beam.Backend.SQL.BeamExtensions+  ( MonadBeamInsertReturning(..)+  , MonadBeamUpdateReturning(..)+  , MonadBeamDeleteReturning(..) +  , SqlSerial(..)+  ) where+ import Database.Beam.Backend import Database.Beam.Backend.SQL import Database.Beam.Query@@ -10,11 +23,8 @@  --import GHC.Generics --- | 'MonadBeam's that support returning the results of an insert statement.+-- | 'MonadBeam's that support returning the newly created rows of an @INSERT@ statement. --   Useful for discovering the real value of a defaulted value.------   Unfortunately, SQL has no standard way of doing this, so it is provided as---   a beam extension. class MonadBeam syntax be handle m =>   MonadBeamInsertReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where   runInsertReturningList@@ -22,9 +32,12 @@        , Projectible (Sql92ExpressionSyntax syntax) (table (QExpr (Sql92ExpressionSyntax syntax) ()))        , FromBackendRow be (table Identity) )     => DatabaseEntity be db (TableEntity table)-    -> SqlInsertValues (Sql92InsertValuesSyntax (Sql92InsertSyntax syntax)) table+    -> SqlInsertValues (Sql92InsertValuesSyntax (Sql92InsertSyntax syntax))+                       (table (QExpr (Sql92InsertExpressionSyntax (Sql92InsertSyntax syntax)) s))     -> m [table Identity] +-- | 'MonadBeam's that support returning the updated rows of an @UPDATE@ statement.+--   Useful for discovering the new values of the updated rows. class MonadBeam syntax be handle m =>   MonadBeamUpdateReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where   runUpdateReturningList@@ -33,5 +46,18 @@        , FromBackendRow be (table Identity) )     => DatabaseEntity be db (TableEntity table)     -> (forall s. table (QField s) -> [ QAssignment (Sql92UpdateFieldNameSyntax (Sql92UpdateSyntax syntax)) (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s ])+    -> (forall s. table (QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s) -> QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s Bool)+    -> m [table Identity]++-- | 'MonadBeam's that suppert returning rows that will be deleted by the given+-- @DELETE@ statement. Useful for deallocating resources based on the value of+-- deleted rows.+class MonadBeam syntax be handle m =>+  MonadBeamDeleteReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where+  runDeleteReturningList+    :: ( Beamable table+       , Projectible (Sql92ExpressionSyntax syntax) (table (QExpr (Sql92ExpressionSyntax syntax) ()))+       , FromBackendRow be (table Identity) )+    => DatabaseEntity be db (TableEntity table)     -> (forall s. table (QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s) -> QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s Bool)     -> m [table Identity]

@@ -216,6 +216,9 @@   charLengthE = sqlFuncOp "CHAR_LENGTH"   bitLengthE = sqlFuncOp "BIT_LENGTH"   octetLengthE = sqlFuncOp "OCTET_LENGTH"+  lowerE = sqlFuncOp "LOWER"+  upperE = sqlFuncOp "UPPER"+  trimE = sqlFuncOp "TRIM"    addE = sqlBinOp "+"   likeE = sqlBinOp "LIKE"

@@ -7,6 +7,7 @@ import Database.Beam.Backend.Types  import Data.Int+import Data.Tagged import Data.Text (Text) import Data.Time (LocalTime) import Data.Typeable@@ -27,6 +28,7 @@ type Sql92SelectProjectionSyntax select = Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax select) type Sql92SelectGroupingSyntax select = Sql92SelectTableGroupingSyntax (Sql92SelectSelectTableSyntax select) type Sql92SelectFromSyntax select = Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)+type Sql92InsertExpressionSyntax select = Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax select)  type Sql92ValueSyntax cmdSyntax = Sql92ExpressionValueSyntax (Sql92ExpressionSyntax cmdSyntax) type Sql92ExpressionSyntax cmdSyntax = Sql92SelectExpressionSyntax (Sql92SelectSyntax cmdSyntax)@@ -182,6 +184,7 @@   -- TODO interval type  class ( HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Int+      , HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Bool       , IsSql92FieldNameSyntax (Sql92ExpressionFieldNameSyntax expr)       , IsSql92QuantifierSyntax (Sql92ExpressionQuantifierSyntax expr)       , Typeable expr ) =>@@ -194,7 +197,10 @@   type Sql92ExpressionExtractFieldSyntax expr :: *    valueE :: Sql92ExpressionValueSyntax expr -> expr-  rowE, coalesceE :: [ expr ] -> expr++  rowE, quantifierListE, coalesceE :: [ expr ] -> expr+  quantifierListE = rowE+   caseE :: [(expr, expr)]         -> expr -> expr   fieldE :: Sql92ExpressionFieldNameSyntax expr -> expr@@ -211,12 +217,36 @@     :: Maybe (Sql92ExpressionQuantifierSyntax expr)     -> expr -> expr -> expr +  -- | Compare the first and second argument for nullable equality, if+  -- they are both not null, return the result of the third expression+  --+  -- Some backends, like @beam-postgres@ totally ignore the third+  -- result, because all equality there is sensible.+  eqMaybeE, neqMaybeE :: expr -> expr -> expr -> expr++  eqMaybeE a b e =+    let aIsNull = isNullE a+        bIsNull = isNullE b+    in caseE [ ( aIsNull `andE` bIsNull, valueE (sqlValueSyntax True) )+             , ( aIsNull `orE` bIsNull, valueE (sqlValueSyntax False) ) ]+             e+++  neqMaybeE a b e =+    let aIsNull = isNullE a+        bIsNull = isNullE b+    in caseE [ ( aIsNull `andE` bIsNull, valueE (sqlValueSyntax False) )+             , ( aIsNull `orE` bIsNull, valueE (sqlValueSyntax True) ) ]+             e+   castE :: expr -> Sql92ExpressionCastTargetSyntax expr -> expr    notE, negateE, isNullE, isNotNullE,     isTrueE, isNotTrueE, isFalseE, isNotFalseE,     isUnknownE, isNotUnknownE, charLengthE,-    octetLengthE, bitLengthE+    octetLengthE, bitLengthE,+    lowerE, upperE,+    trimE     :: expr     -> expr @@ -290,3 +320,10 @@   IsSql92FromOuterJoinSyntax from where    outerJoin :: from -> from -> Maybe (Sql92FromExpressionSyntax from) -> from++-- Tagged++instance HasSqlValueSyntax vs t => HasSqlValueSyntax vs (Tagged tag t) where+  sqlValueSyntax = sqlValueSyntax . untag++instance IsSqlExpressionSyntaxStringType e t => IsSqlExpressionSyntaxStringType e (Tagged tag t)

@@ -15,7 +15,7 @@   deriving (Show, Eq, Ord, Enum, Bits)  newtype SqlSerial a = SqlSerial { unSerial :: a }-  deriving (Show, Read, Eq, Ord)+  deriving (Show, Read, Eq, Ord, Num, Integral, Real, Enum) instance FromBackendRow be x => FromBackendRow be (SqlSerial x) where   fromBackendRow = SqlSerial <$> fromBackendRow instance Json.FromJSON a => Json.FromJSON (SqlSerial a) where

@@ -5,7 +5,6 @@  module Database.Beam.Backend.Types   ( BeamBackend(..)-  , Auto(..)    , FromBackendRowF(..), FromBackendRowM   , parseOneField, peekField, checkNextNNull@@ -16,7 +15,7 @@  import           Control.Monad.Free.Church import           Control.Monad.Identity-import qualified Data.Aeson as Json+import           Data.Tagged import           Data.Vector.Sized (Vector) import qualified Data.Vector.Sized as Vector @@ -31,26 +30,6 @@   -- | Requirements to marshal a certain type from a database of a particular backend   type BackendFromField be :: * -> Constraint --- | Newtype wrapper for types that may be given default values by the database.---   Essentially, a wrapper around 'Maybe x'.------   When a value of type 'Auto x' is written to a database (via @INSERT@ or---   @UPDATE@, for example), backends will translate a 'Nothing' value into an---   expression that will evaluate to whatever default value the database would---   choose. This is useful to insert rows with columns that are---   auto-incrementable or have a @DEFAULT@ value.------   When read from the database, the wrapped value will always be a 'Just'---   value. This isn't currently enforced at the type-level, but may be in---   future versions of beam.-newtype Auto x = Auto { unAuto :: Maybe x }-  deriving (Show, Read, Eq, Ord, Generic, Monoid)-instance Json.FromJSON a => Json.FromJSON (Auto a) where-  parseJSON a = Auto <$> Json.parseJSON a-instance Json.ToJSON a => Json.ToJSON (Auto a) where-  toJSON (Auto a) = Json.toJSON a-  toEncoding (Auto a) = Json.toEncoding a- data FromBackendRowF be f where   ParseOneField :: BackendFromField be a => (a -> f) -> FromBackendRowF be f   PeekField :: BackendFromField be a => (Maybe a -> f) -> FromBackendRowF be f@@ -182,8 +161,10 @@     do isNull <- checkNextNNull (valuesNeeded (Proxy @be) (Proxy @(Maybe x)))        if isNull then pure Nothing else Just <$> fromBackendRow   valuesNeeded be _ = valuesNeeded be (Proxy @x)-instance (BeamBackend be, FromBackendRow be (Maybe x)) => FromBackendRow be (Auto x) where-  fromBackendRow = Auto <$> fromBackendRow-  valuesNeeded be _ = valuesNeeded be (Proxy @(Maybe x))  deriving instance Generic (a, b, c, d, e, f, g, h)++-- Tagged++instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where+  fromBackendRow = Tagged <$> fromBackendRow

@@ -22,7 +22,7 @@ data BeamURIOpener c where   BeamURIOpener :: MonadBeam syntax be hdl m                 => c syntax be hdl m-                -> (forall a. URI -> (hdl -> IO a) -> IO a)+                -> (URI -> IO (hdl, IO ()))                 -> BeamURIOpener c newtype BeamURIOpeners c where   BeamURIOpeners :: M.Map String (BeamURIOpener c) -> BeamURIOpeners c@@ -32,8 +32,17 @@   mappend (BeamURIOpeners a) (BeamURIOpeners b) =     BeamURIOpeners (mappend a b) +data OpenedBeamConnection c where+  OpenedBeamConnection+    :: MonadBeam syntax be hdl m+    => { openedBeamDatabase :: c syntax be hdl m+       , openedBeamHandle   :: hdl+       , closeBeamConnection :: IO ()+     } -> OpenedBeamConnection c+ mkUriOpener :: MonadBeam syntax be hdl m-            => String -> (forall a. URI -> (hdl -> IO a) -> IO a)+            => String+            -> (URI -> IO (hdl, IO ()))             -> c syntax be hdl m             -> BeamURIOpeners c mkUriOpener schemeNm opener c = BeamURIOpeners (M.singleton schemeNm (BeamURIOpener c opener))@@ -52,11 +61,24 @@                  -> (forall syntax be hdl m. MonadBeam syntax be hdl m =>                       c syntax be hdl m -> hdl -> IO a)                  -> IO a-withDbConnection (BeamURIOpeners protos) uri actionWithDb =+withDbConnection protos uri actionWithDb =+  bracket (openDbConnection protos uri) closeBeamConnection $+  \(OpenedBeamConnection c hdl _) -> actionWithDb c hdl++openDbConnection :: forall c+                  . BeamURIOpeners c+                 -> String+                 -> IO (OpenedBeamConnection c)+openDbConnection protos uri = do+  (parsedUri, BeamURIOpener c openURI) <- findURIOpener protos uri+  (hdl, closeHdl) <- openURI parsedUri+  pure (OpenedBeamConnection c hdl closeHdl)++findURIOpener :: BeamURIOpeners c -> String -> IO (URI, BeamURIOpener c)+findURIOpener (BeamURIOpeners protos) uri =   case parseURI uri of     Nothing -> throwIO BeamOpenURIInvalid     Just parsedUri ->       case M.lookup (uriScheme parsedUri) protos of         Nothing -> throwIO (BeamOpenURIUnsupportedScheme (uriScheme parsedUri))-        Just (BeamURIOpener c withURI) ->-          withURI parsedUri (actionWithDb c)+        Just opener -> pure (parsedUri, opener)

@@ -25,7 +25,15 @@     -- * Operators     , module Database.Beam.Query.Operator +    -- ** ANSI SQL Booleans+    , Beam.SqlBool+    , isTrue_, isNotTrue_+    , isFalse_, isNotFalse_+    , isUnknown_, isNotUnknown_+    , unknownAs_, sqlBool_+     -- ** Unquantified comparison operators+    , HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)     , SqlEq(..), SqlOrd(..)      -- ** Quantified Comparison Operators #quantified-comparison-operator#@@ -42,20 +50,21 @@     -- * SQL Command construction and execution     -- ** @SELECT@     , SqlSelect(..)-    , select, lookup+    , select, lookup_     , runSelectReturningList     , runSelectReturningOne     , dumpSqlSelect      -- ** @INSERT@     , SqlInsert(..)-    , insert+    , insert, insertOnly     , runInsert      , SqlInsertValues(..)     , insertExpressions     , insertValues     , insertFrom+    , insertData      -- ** @UPDATE@     , SqlUpdate(..)@@ -74,7 +83,8 @@ import Database.Beam.Query.CustomSQL import Database.Beam.Query.Extensions import Database.Beam.Query.Internal-import Database.Beam.Query.Operator+import Database.Beam.Query.Operator hiding (SqlBool)+import qualified Database.Beam.Query.Operator as Beam import Database.Beam.Query.Ord import Database.Beam.Query.Relationships import Database.Beam.Query.Types (QGenExpr) -- hide QGenExpr constructor@@ -88,14 +98,17 @@ import Control.Monad.Identity import Control.Monad.Writer +import Data.Text (Text)+import Data.Proxy+ -- * Query  data QueryInaccessible  -- | A version of the table where each field is a 'QGenExpr'-type QGenExprTable ctxt syntax tbl = forall s. tbl (QGenExpr ctxt syntax s)+type QGenExprTable ctxt syntax s tbl = tbl (QGenExpr ctxt syntax s) -type QExprTable syntax tbl = QGenExprTable QValueContext syntax tbl+type QExprTable syntax s tbl = QGenExprTable QValueContext syntax s tbl  -- * SELECT @@ -120,19 +133,21 @@  -- | Convenience function to generate a 'SqlSelect' that looks up a table row --   given a primary key.-lookup :: ( HasQBuilder syntax-          , Sql92SelectSanityCheck syntax+lookup_ :: ( HasQBuilder syntax+           , Sql92SelectSanityCheck syntax -          , SqlValableTable (PrimaryKey table) (Sql92SelectExpressionSyntax syntax)-          , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool+           , SqlValableTable (PrimaryKey table) (Sql92SelectExpressionSyntax syntax)+           , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool -          , Beamable table, Table table+           , HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey table) -          , Database db )-       => DatabaseEntity be db (TableEntity table)-       -> PrimaryKey table Identity-       -> SqlSelect syntax (table Identity)-lookup tbl tblKey =+           , Beamable table, Table table++           , Database be db )+        => DatabaseEntity be db (TableEntity table)+        -> PrimaryKey table Identity+        -> SqlSelect syntax (table Identity)+lookup_ tbl tblKey =   select $   filter_ (\t -> pk t ==. val_ tblKey) $   all_ tbl@@ -164,63 +179,101 @@ -- * INSERT  -- | Represents a SQL @INSERT@ command that has not yet been run-newtype SqlInsert syntax = SqlInsert syntax+data SqlInsert syntax+  = SqlInsert syntax+  | SqlInsertNoRows +-- | Generate a 'SqlInsert' over only certain fields of a table+insertOnly :: ( IsSql92InsertSyntax syntax, Projectible Text (QExprToField r) )+           => DatabaseEntity be db (TableEntity table)+              -- ^ Table to insert into+           -> (table (QField s) -> QExprToField r)+           -> SqlInsertValues (Sql92InsertValuesSyntax syntax) r+              -- ^ Values to insert. See 'insertValues', 'insertExpressions', 'insertData', and 'insertFrom' for possibilities.+           -> SqlInsert syntax+insertOnly _ _ SqlInsertValuesEmpty = SqlInsertNoRows+insertOnly (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkProj (SqlInsertValues vs) =+    SqlInsert (insertStmt tblNm proj vs)+  where+    tblFields = changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QField False tblNm name)) tblSettings+    proj = execWriter (project' (Proxy @AnyType) (\_ f -> tell [f ""] >> pure f)+                                (mkProj tblFields))+ -- | Generate a 'SqlInsert' given a table and a source of values.-insert :: IsSql92InsertSyntax syntax =>-          DatabaseEntity be db (TableEntity table)+insert :: ( IsSql92InsertSyntax syntax, Projectible Text (table (QField s)) )+       => DatabaseEntity be db (TableEntity table)           -- ^ Table to insert into-       -> SqlInsertValues (Sql92InsertValuesSyntax syntax) table+       -> SqlInsertValues (Sql92InsertValuesSyntax syntax) (table (QExpr (Sql92InsertExpressionSyntax syntax) s))           -- ^ Values to insert. See 'insertValues', 'insertExpressions', and 'insertFrom' for possibilities.        -> SqlInsert syntax-insert (DatabaseEntity (DatabaseTable tblNm tblSettings)) (SqlInsertValues vs) =-    SqlInsert (insertStmt tblNm tblFields vs)-  where-    tblFields = allBeamValues (\(Columnar' f) -> _fieldName f) tblSettings+insert tbl values = insertOnly tbl id values  -- | Run a 'SqlInsert' in a 'MonadBeam' runInsert :: (IsSql92Syntax cmd, MonadBeam cmd be hdl m)           => SqlInsert (Sql92InsertSyntax cmd) -> m ()+runInsert SqlInsertNoRows = pure () runInsert (SqlInsert i) = runNoReturn (insertCmd i)  -- | Represents a source of values that can be inserted into a table shaped like --   'tbl'.-newtype SqlInsertValues insertValues (tbl :: (* -> *) -> *)+data SqlInsertValues insertValues proj --(tbl :: (* -> *) -> *)     = SqlInsertValues insertValues+    | SqlInsertValuesEmpty --- | Build a 'SqlInsertValues' from series of expressions+-- | Build a 'SqlInsertValues' from series of expressions in tables insertExpressions ::-    forall syntax table.+    forall syntax table s.     ( Beamable table     , IsSql92InsertValuesSyntax syntax ) =>-    (forall s. [ table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s) ]) ->-    SqlInsertValues syntax table+    (forall s'. [ table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') ]) ->+    SqlInsertValues syntax (table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s)) insertExpressions tbls =-    SqlInsertValues $-    insertSqlExpressions (map mkSqlExprs tbls)+  case sqlExprs of+    [] -> SqlInsertValuesEmpty+    _  -> SqlInsertValues (insertSqlExpressions sqlExprs)     where-      mkSqlExprs :: forall s. table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s) -> [Sql92InsertValuesExpressionSyntax syntax]+      sqlExprs = map mkSqlExprs tbls++      mkSqlExprs :: forall s'. table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') -> [Sql92InsertValuesExpressionSyntax syntax]       mkSqlExprs = allBeamValues (\(Columnar' (QExpr x)) -> x "t")  -- | Build a 'SqlInsertValues' from concrete table values insertValues ::-    forall table syntax.+    forall table syntax s.     ( Beamable table     , IsSql92InsertValuesSyntax syntax     , FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92InsertValuesExpressionSyntax syntax))) table) =>-    [ table Identity ] -> SqlInsertValues syntax table-insertValues x = insertExpressions (map val_ x :: forall s. [table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s) ])+    [ table Identity ] -> SqlInsertValues syntax (table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s))+insertValues x = insertExpressions (map val_ x :: forall s'. [table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') ]) +-- | Build a 'SqlInsertValues' from arbitrarily shaped data containing expressions+insertData :: forall syntax r+            . ( Projectible (Sql92InsertValuesExpressionSyntax syntax) r+              , IsSql92InsertValuesSyntax syntax )+           => [ r ] -> SqlInsertValues syntax r+insertData rows =+  case rows of+    [] -> SqlInsertValuesEmpty+    _  -> SqlInsertValues (insertSqlExpressions (map mkSqlExprs rows))+  where+    mkSqlExprs :: r -> [Sql92InsertValuesExpressionSyntax syntax]+    mkSqlExprs r = execWriter (project' (Proxy @AnyType) (\_ s -> tell [ s "t" ] >> pure s) r)+ -- | Build a 'SqlInsertValues' from a 'SqlSelect' that returns the same table-insertFrom ::-    IsSql92InsertValuesSyntax syntax =>-    SqlSelect (Sql92InsertValuesSelectSyntax syntax) (table Identity) -> SqlInsertValues syntax table-insertFrom (SqlSelect s) = SqlInsertValues (insertFromSql s)+insertFrom+    :: ( IsSql92InsertValuesSyntax syntax+       , HasQBuilder (Sql92InsertValuesSelectSyntax syntax)+       , Projectible (Sql92SelectExpressionSyntax (Sql92InsertValuesSelectSyntax syntax)) r )+    => Q (Sql92InsertValuesSelectSyntax syntax) db QueryInaccessible r+    -> SqlInsertValues syntax r+insertFrom s = SqlInsertValues (insertFromSql (buildSqlQuery "t" s))  -- * UPDATE  -- | Represents a SQL @UPDATE@ statement for the given @table@.-newtype SqlUpdate syntax (table :: (* -> *) -> *) = SqlUpdate syntax+data SqlUpdate syntax (table :: (* -> *) -> *)+  = SqlUpdate syntax+  | SqlIdentityUpdate -- An update with no assignments  -- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to --   build a @WHERE@ clause.@@ -240,13 +293,15 @@           -- ^ Build a @WHERE@ clause given a table containing expressions        -> SqlUpdate syntax table update (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkAssignments mkWhere =-  SqlUpdate (updateStmt tblNm assignments (Just (where_ "t")))+  case assignments of+    [] -> SqlIdentityUpdate+    _  -> SqlUpdate (updateStmt tblNm assignments (Just (where_ "t")))   where     assignments = concatMap (\(QAssignment as) -> as) (mkAssignments tblFields)     QExpr where_ = mkWhere tblFieldExprs -    tblFields = changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QField tblNm name)) tblSettings-    tblFieldExprs = changeBeamRep (\(Columnar' (QField _ nm)) -> Columnar' (QExpr (pure (fieldE (unqualifiedField nm))))) tblFields+    tblFields = changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QField False tblNm name)) tblSettings+    tblFieldExprs = changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar' (QExpr (pure (fieldE (unqualifiedField nm))))) tblFields  -- | Generate a 'SqlUpdate' that will update the given table with the given value. --@@ -261,6 +316,8 @@         , SqlValableTable (PrimaryKey table) (Sql92UpdateExpressionSyntax syntax)         , SqlValableTable table (Sql92UpdateExpressionSyntax syntax) +        , HasTableEquality (Sql92UpdateExpressionSyntax syntax) (PrimaryKey table)+         , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92UpdateExpressionSyntax syntax)) Bool         )      => DatabaseEntity be db (TableEntity table)@@ -287,6 +344,7 @@ runUpdate :: (IsSql92Syntax cmd, MonadBeam cmd be hdl m)           => SqlUpdate (Sql92UpdateSyntax cmd) tbl -> m () runUpdate (SqlUpdate u) = runNoReturn (updateCmd u)+runUpdate SqlIdentityUpdate = pure ()  -- * DELETE 

@@ -5,7 +5,7 @@     --   for more detail      aggregate_-  , filterWhere_+  , filterWhere_, filterWhere_'    , QGroupable(..) @@ -28,6 +28,8 @@   ) where  import Database.Beam.Query.Internal+import Database.Beam.Query.Operator+import Database.Beam.Query.Ord  import Database.Beam.Backend.SQL import Database.Beam.Schema.Tables@@ -134,25 +136,28 @@ allInGroupExplicitly_ = Just setQuantifierAll  -- ** Aggregations+--+--    These functions all return 'Maybe' (except for `count_` and+--    `countAll_`) because empty aggregates return SQL @NULL@ values.  -- | SQL @MIN(ALL ..)@ function (but without the explicit ALL) min_ :: IsSql92AggregationExpressionSyntax expr-     => QExpr expr s a -> QAgg expr s a+     => QExpr expr s a -> QAgg expr s (Maybe a) min_ = minOver_ allInGroup_  -- | SQL @MAX(ALL ..)@ function (but without the explicit ALL) max_ :: IsSql92AggregationExpressionSyntax expr-     => QExpr expr s a -> QAgg expr s a+     => QExpr expr s a -> QAgg expr s (Maybe a) max_ = maxOver_ allInGroup_  -- | SQL @AVG(ALL ..)@ function (but without the explicit ALL) avg_ :: ( IsSql92AggregationExpressionSyntax expr, Num a )-     => QExpr expr s a -> QAgg expr s a+     => QExpr expr s a -> QAgg expr s (Maybe a) avg_ = avgOver_ allInGroup_  -- | SQL @SUM(ALL ..)@ function (but without the explicit ALL) sum_ :: ( IsSql92AggregationExpressionSyntax expr, Num a )-     => QExpr expr s a -> QAgg expr s a+     => QExpr expr s a -> QAgg expr s (Maybe a) sum_ = sumOver_ allInGroup_  -- | SQL @COUNT(*)@ function@@ -186,7 +191,7 @@ minOver_, maxOver_   :: IsSql92AggregationExpressionSyntax expr   => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s a -> QAgg expr s a+  -> QExpr expr s a -> QAgg expr s (Maybe a) minOver_ q (QExpr a) = QExpr (minE q <$> a) maxOver_ q (QExpr a) = QExpr (maxE q <$> a) @@ -194,7 +199,7 @@   :: ( IsSql92AggregationExpressionSyntax expr      , Num a )   => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s a -> QAgg expr s a+  -> QExpr expr s a -> QAgg expr s (Maybe a) avgOver_ q (QExpr a) = QExpr (avgE q <$> a) sumOver_ q (QExpr a) = QExpr (sumE q <$> a) @@ -205,31 +210,41 @@   -> QExpr expr s a -> QAgg expr s b countOver_ q (QExpr a) = QExpr (countE q <$> a) +-- | SQL @EVERY@, @SOME@, and @ANY@ aggregates. Operates over+-- 'SqlBool' only, as the result can be @NULL@, even if all inputs are+-- known (no input rows). everyOver_, someOver_, anyOver_   :: IsSql99AggregationExpressionSyntax expr   => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s Bool -> QAgg expr s Bool+  -> QExpr expr s SqlBool -> QAgg expr s SqlBool everyOver_ q (QExpr a) = QExpr (everyE q <$> a) someOver_  q (QExpr a) = QExpr (someE  q <$> a) anyOver_   q (QExpr a) = QExpr (anyE   q <$> a)  -- | Support for FILTER (WHERE ...) syntax for aggregates.---   Part of SQL2003 Advanced OLAP operations feature (T612)+--   Part of SQL2003 Advanced OLAP operations feature (T612).+--+-- See 'filterWhere_'' for a version that accepts 'SqlBool'. filterWhere_ :: IsSql2003ExpressionElementaryOLAPOperationsSyntax expr              => QAgg expr s a -> QExpr expr s Bool -> QAgg expr s a-filterWhere_ (QExpr agg) (QExpr cond) = QExpr (liftA2 filterAggE agg cond)+filterWhere_ agg cond = filterWhere_' agg (sqlBool_ cond) +-- | Like 'filterWhere_' but accepting 'SqlBool'.+filterWhere_' :: IsSql2003ExpressionElementaryOLAPOperationsSyntax expr+              => QAgg expr s a -> QExpr expr s SqlBool -> QAgg expr s a+filterWhere_' (QExpr agg) (QExpr cond) = QExpr (liftA2 filterAggE agg cond)+ -- | SQL99 @EVERY(ALL ..)@ function (but without the explicit ALL) every_ :: IsSql99AggregationExpressionSyntax expr-       => QExpr expr s Bool -> QAgg expr s Bool+       => QExpr expr s SqlBool -> QAgg expr s SqlBool every_ = everyOver_ allInGroup_  -- | SQL99 @SOME(ALL ..)@ function (but without the explicit ALL) some_ :: IsSql99AggregationExpressionSyntax expr-      => QExpr expr s Bool -> QAgg expr s Bool+      => QExpr expr s SqlBool -> QAgg expr s SqlBool some_  = someOver_  allInGroup_  -- | SQL99 @ANY(ALL ..)@ function (but without the explicit ALL) any_ :: IsSql99AggregationExpressionSyntax expr-     => QExpr expr s Bool -> QAgg expr s Bool+     => QExpr expr s SqlBool -> QAgg expr s SqlBool any_   = anyOver_   allInGroup_

@@ -2,12 +2,15 @@  module Database.Beam.Query.Combinators     ( -- * Various SQL functions and constructs-      coalesce_, position_+      coalesce_, fromMaybe_, position_     , charLength_, octetLength_, bitLength_     , currentTimestamp_+    , lower_, upper_+    , trim_      -- ** @IF-THEN-ELSE@ support     , if_, then_, else_+    , then_'      -- * SQL @UPDATE@ assignments     , (<-.), current_@@ -15,15 +18,16 @@     -- * Project Haskell values to 'QGenExpr's     , HaskellLiteralForQExpr     , SqlValable(..), SqlValableTable-    , default_, auto_+    , default_      -- * General query combinators      , all_-    , allFromView_, join_, guard_, filter_-    , related_, relatedBy_-    , leftJoin_, perhaps_-    , outerJoin_+    , allFromView_, join_, join_'+    , guard_, guard_', filter_, filter_'+    , related_, relatedBy_, relatedBy_'+    , leftJoin_, leftJoin_'+    , perhaps_, outerJoin_, outerJoin_'     , subselect_, references_      , nub_@@ -81,7 +85,7 @@  -- | Introduce all entries of a table into the 'Q' monad all_ :: forall be (db :: (* -> *) -> *) table select s.-        ( Database db+        ( Database be db         , IsSql92SelectSyntax select          , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))@@ -92,11 +96,11 @@        => DatabaseEntity be db (TableEntity table)        -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s)) all_ (DatabaseEntity (DatabaseTable tblNm tblSettings)) =-    Q $ liftF (QAll tblNm tblSettings (\_ -> Nothing) id)+    Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd)  -- | Introduce all entries of a view into the 'Q' monad allFromView_ :: forall be (db :: (* -> *) -> *) table select s.-                ( Database db+                ( Database be db                 , IsSql92SelectSyntax select                  , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))@@ -106,11 +110,14 @@                => DatabaseEntity be db (ViewEntity table)                -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s)) allFromView_ (DatabaseEntity (DatabaseView tblNm tblSettings)) =-    Q $ liftF (QAll tblNm tblSettings (\_ -> Nothing) id)+    Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd) --- | Introduce all entries of a table into the 'Q' monad based on the given---   QExpr-join_ :: ( Database db, Table table+-- | Introduce all entries of a table into the 'Q' monad based on the+--   given QExpr. The join condition is expected to return a+--   'Bool'. For a version that takes 'SqlBool' (a possibly @UNKNOWN@+--   boolean, that maps more closely to the SQL standard), see+--   'join_''.+join_ :: ( Database be db, Table table          , IsSql92SelectSyntax select          , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))          , Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)@@ -118,9 +125,21 @@          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_ (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkOn =-    Q $ liftF (QAll tblNm tblSettings (\tbl -> let QExpr on = mkOn tbl in Just on) id)+join_ tbl mkOn = join_' tbl (sqlBool_ . mkOn) +-- | Like 'join_', but accepting an @ON@ condition that returns+-- 'SqlBool'+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)+ -- | Introduce a table using a left join with no ON clause. Because this is not --   an inner join, the resulting table is made nullable. This means that each --   field that would normally have type 'QExpr x' will now have type 'QExpr@@ -140,6 +159,12 @@                                             Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) a) $                                   rewriteThread (Proxy @s) r)) +-- | Outer join. every row of each table, returning @NULL@ for any row+-- of either table for which the join condition finds no related rows.+--+-- This expects a join expression returning 'Bool', for a version that+-- accepts a 'SqlBool' (a possibly @UNKNOWN@ boolean, that maps more+-- closely to the SQL standard), see 'outerJoin_'' outerJoin_ :: forall s a b select db.               ( Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b               , ThreadRewritable (QNested s) a, ThreadRewritable (QNested s) b@@ -151,7 +176,23 @@            -> ( (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_ (Q a) (Q b) on_ =+outerJoin_ a b on_ = outerJoin_' a b (sqlBool_ . on_)++-- | Like 'outerJoin_', but accepting 'SqlBool'. Pairs of rows for+-- which the join condition is unknown are considered to be unrelated,+-- by SQL compliant databases at least.+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')@@ -168,6 +209,9 @@ --   this is not an inner join, the resulting table is made nullable. This means --   that each field that would normally have type 'QExpr x' will now have type --   'QExpr (Maybe x)'.+--+--   The @ON@ condition given must return 'Bool'. For a version that+--   accepts an @ON@ condition returning 'SqlBool', see 'leftJoin_''. leftJoin_ :: forall s r select db.            ( Projectible (Sql92SelectExpressionSyntax select) r            , IsSql92SelectSyntax select@@ -176,7 +220,18 @@           => 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_ (Q sub) on_ =+leftJoin_ sub on_ = leftJoin_' sub (sqlBool_ . on_)++-- | Like 'leftJoin_', but accepts an @ON@ clause returning 'SqlBool'.+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)@@ -192,25 +247,45 @@ subselect_ (Q q') =   Q (liftF (QSubSelect q' (rewriteThread (Proxy @s)))) --- | Only allow results for which the 'QExpr' yields 'True'+-- | Only allow results for which the 'QExpr' yields 'True'. For a+-- version that operates over possibly @NULL@ 'SqlBool's, see+-- 'guard_''. guard_ :: forall select db s.           ( IsSql92SelectSyntax select ) =>           QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool -> Q select db s ()-guard_ (QExpr guardE') =-    Q (liftF (QGuard guardE' ()))+guard_ = guard_' . sqlBool_ --- | Synonym for @clause >>= \x -> guard_ (mkExpr x)>> pure x@+-- | Only allow results for which the 'QExpr' yields @TRUE@.+--+-- This function operates over 'SqlBool', which are like haskell+-- 'Bool's, except for the special @UNKNOWN@ value that occurs when+-- comparisons include @NULL@. For a version that operates over known+-- non-@NULL@ booleans, see 'guard_'.+guard_' :: forall select db s+         . IsSql92SelectSyntax select+        => QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool -> Q select db s ()+guard_' (QExpr guardE') = Q (liftF (QGuard guardE' ()))++-- | Synonym for @clause >>= \x -> guard_ (mkExpr x)>> pure x@. Use 'filter_'' for comparisons with 'SqlBool' 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 +-- | Synonym for @clause >>= \x -> guard_' (mkExpr x)>> pure x@. Use 'filter_' for comparisons with 'Bool'+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+ -- | Introduce all entries of the given table which are referenced by the given 'PrimaryKey' related_ :: forall be db rel select s.             ( IsSql92SelectSyntax select+            , HasTableEquality (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) (PrimaryKey rel)             , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool-            , Database db, Table rel ) =>+            , 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))@@ -219,7 +294,7 @@  -- | Introduce all entries of the given table which for which the expression (which can depend on the queried table returns true) relatedBy_ :: forall be db rel select s.-              ( Database db, Table rel+              ( Database be db, Table rel               , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool               , IsSql92SelectSyntax select )            => DatabaseEntity be db (TableEntity rel)@@ -228,9 +303,21 @@            -> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s)) relatedBy_ = join_ +-- | Introduce all entries of the given table which for which the expression (which can depend on the queried table returns true)+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_'+ -- | Generate an appropriate boolean 'QGenExpr' comparing the given foreign key --   to the given table. Useful for creating join conditions. 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@@ -292,7 +379,7 @@   , ProjectibleInSelectSyntax select (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)   , Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select) =>   Q select (db :: (* -> *) -> *) s (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)-  -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a+  -> QGenExpr ctxt (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a subquery_ q =   QExpr (\tbl -> subqueryE (buildSqlQuery tbl q)) @@ -326,6 +413,24 @@ position_ (QExpr needle) (QExpr haystack) =   QExpr (liftA2 likeE needle haystack) +-- | SQL @LOWER@ function+lower_ :: ( IsSqlExpressionSyntaxStringType syntax text+          , IsSql92ExpressionSyntax syntax )+       => QGenExpr context syntax s text -> QGenExpr context syntax s text+lower_ (QExpr s) = QExpr (lowerE <$> s)++-- | SQL @UPPER@ function+upper_ :: ( IsSqlExpressionSyntaxStringType syntax text+          , IsSql92ExpressionSyntax syntax )+       => QGenExpr context syntax s text -> QGenExpr context syntax s text+upper_ (QExpr s) = QExpr (upperE <$> s)++-- | SQL @TRIM@ function+trim_ :: ( IsSqlExpressionSyntaxStringType syntax text+         , IsSql92ExpressionSyntax syntax )+      => QGenExpr context syntax s text -> QGenExpr context syntax s text+trim_ (QExpr s) = QExpr (trimE <$> s)+ -- | Combine all the given boolean value 'QGenExpr's with the '&&.' operator. allE :: ( IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool) =>         [ QGenExpr context syntax s Bool ] -> QGenExpr context syntax s Bool@@ -339,7 +444,8 @@ -- | Extract an expression representing the current (non-UPDATEd) value of a 'QField' current_ :: IsSql92ExpressionSyntax expr          => QField s ty -> QExpr expr s ty-current_ (QField _ nm) = QExpr (pure (fieldE (unqualifiedField nm)))+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@@ -351,8 +457,8 @@         -> rhs         -> QAssignment fieldName expr s instance SqlUpdatable expr s (QField s a) (QExpr expr s a) where-  QField _ fieldNm <-. QExpr expr =-    QAssignment [(unqualifiedField fieldNm, expr "t")]+  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@@ -362,12 +468,12 @@     QAssignment $     allBeamValues (\(Columnar' (Const assignments)) -> assignments) $     runIdentity $-    zipBeamFieldsM (\(Columnar' (QField _ f) :: Columnar' (QField s) t) (Columnar' (QExpr e)) ->+    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 tblName fieldName') :: Columnar' (Nullable (QField s)) a) ->-                                Columnar' (QField tblName fieldName') :: Columnar' (QField s)  a) lhs+    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'@@ -504,9 +610,6 @@          => QGenExpr ctxt expr s a default_ = QExpr (pure defaultE) -auto_ :: QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s (Auto a)-auto_ = unsafeRetype- -- * Window functions  noBounds_ :: QFrameBounds syntax@@ -732,12 +835,15 @@  -- * Nullable checking -data QIfCond context expr s a = QIfCond (QGenExpr context expr s Bool) (QGenExpr context expr s a)+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 cond res+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 @@ -749,38 +855,44 @@   QExpr (\tbl -> caseE (map (\(QIfCond (QExpr cond) (QExpr res)) -> (cond tbl, res tbl)) conds) (elseExpr tbl))  -- | SQL @COALESCE@ support-coalesce_ :: IsSql92ExpressionSyntax expr =>-             [ QExpr expr s (Maybe a) ] -> QExpr expr s a -> QExpr expr s a+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 +-- | Converta a 'Maybe' value to a concrete value, by suppling a default+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+ -- | Type class for anything which can be checked for null-ness. This includes 'QExpr (Maybe a)' as -- well as 'Table's or 'PrimaryKey's over 'Nullable QExpr'. class IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax a nonNullA s | a s -> syntax, a -> nonNullA, a -> s, nonNullA -> s where     -- | Returns a 'QExpr' that evaluates to true when the first argument is not null-    isJust_ :: a -> QExpr syntax s Bool+    isJust_ :: a -> QGenExpr ctxt syntax s Bool      -- | Returns a 'QExpr' that evaluates to true when the first argument is null-    isNothing_ :: a -> QExpr syntax s Bool+    isNothing_ :: a -> QGenExpr ctxt syntax s Bool      -- | Given an object (third argument) which may or may not be null, return the default value if     -- null (first argument), or transform the value that could be null to yield the result of the     -- expression (second argument)-    maybe_ :: QExpr syntax s y -> (nonNullA -> QExpr syntax s y) -> a -> QExpr syntax s y+    maybe_ :: QGenExpr ctxt syntax s y -> (nonNullA -> QGenExpr ctxt syntax s y) -> a -> QGenExpr ctxt syntax s y -instance IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax (QExpr syntax s (Maybe x)) (QExpr syntax s x) s where+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))+    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 (QExpr syntax s))) (t (QExpr syntax s)) s where+    => 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 =

@@ -1,18 +1,37 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} --- | Allows the creation of custom SQL expressions from arbitrary 'ByteStrings'.+-- | Allows the creation of custom SQL expressions from arbitrary string-like values. -----   Simply create a function with an arbitrary number of 'ByteString' arguments---   that returns a 'ByteString'. Then, apply 'customExpr_' to your function.---   This will result in a function with the same arity, that takes in---   'QGenExpr's instead of 'ByteString's', and returns a 'QGenExpr' as well.+--   Simply write a polymorphic function with an arbitrary number of arguments,+--   all of the same type, and returns a value of the same type. The type will+--   have instances of 'Monoid' and 'IsString'. -----   Semantically, the expression builder function is called with arguments---   representing SQL expressions, that, when evaluated, will evaluate to the---   result of the expressions supplied as arguments to 'customExpr_'. See the---   section on <http://tathougies.github.io/beam/user-guide/queries/custom-queries/  extensibility>---   in the user guide for example usage.+--   For example, to implement a function @MYFUNC@ that takes three arguments+--+-- @+-- myFuncImpl :: (Monoid a, IsString a) => a -> a -> a -> a+-- @+--+--   Then, apply 'customExpr_' to your function.  This will result in a function+--   with the same arity, that takes in and returns 'QGenExpr's instead of+--   generic @a@s.+--+--   The returned function is polymorphic in the types of SQL expressions it+--   will accept, but you can give it a more specific signature. For example, to+--   mandate that we receive two 'Int's and a 'T.Text' and return a 'Bool'.+--+-- @+-- myFunc_ :: QGenExpr e ctxt s Int -> QGenExpr e ctxt s Int -> QGenExpr e ctxt s T.Text -> QGenExpr e ctxt s Bool+-- myFunc_ = customExpr_ myFuncImpl+-- @+--+--   Semantically, the expression builder function (@myFuncImpl@ in this case)+--   is called with arguments representing SQL expressions, that, when+--   evaluated, will evaluate to the result of the expressions supplied as+--   arguments to 'customExpr_'. See the section on+--   <http://tathougies.github.io/beam/user-guide/extensibility/+--   extensibility> in the user guide for example usage. module Database.Beam.Query.CustomSQL   (   -- * The 'customExpr_' function@@ -40,11 +59,11 @@   IsCustomSqlSyntax syntax where   data CustomSqlSyntax syntax :: * -  -- | Given an arbitrary 'ByteString', produce a 'syntax' that represents the+  -- | Given an arbitrary string-like expression, produce a 'syntax' that represents the   --   'ByteString' as a SQL expression.   customExprSyntax :: CustomSqlSyntax syntax -> syntax -  -- | Given an arbitrary 'syntax', produce a 'ByteString' that corresponds to+  -- | Given an arbitrary 'syntax', produce a string-like value that corresponds to   --   how that syntax would look when rendered in the backend.   renderSyntax :: syntax -> CustomSqlSyntax syntax @@ -70,8 +89,6 @@   customExpr_ (CustomSqlSnippet mkSyntax) = QExpr (customExprSyntax . mkSyntax) instance (IsCustomExprFn a res, IsCustomSqlSyntax syntax) => IsCustomExprFn (CustomSqlSnippet syntax -> a) (QGenExpr ctxt syntax s r -> res) where   customExpr_ fn (QExpr e) = customExpr_ $ fn (CustomSqlSnippet (renderSyntax . e))---- customExpr :: IsCustomExprFn   -- | Force a 'QGenExpr' to be typed as a value expression (a 'QExpr'). Useful --   for getting around type-inference errors with supplying the entire type.

@@ -1,10 +1,10 @@ module Database.Beam.Query.Extensions   ( -- * Various combinators corresponding to SQL extensions -    -- * T614 NTILE function+    -- ** T614 NTILE function     ntile_ -    -- * T615 LEAD and LAG function+    -- ** T615 LEAD and LAG function   , lead1_, lag1_, lead_, lag_   , leadWithDefault_, lagWithDefault_ 

@@ -38,9 +38,9 @@             -> QF select db s next    QAll :: Beamable table-       => T.Text -> TableSettings table+       => (TablePrefix -> T.Text -> Sql92SelectFromSyntax select) -> TableSettings table        -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))-       -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> next) -> QF select db s next+       -> ((T.Text, table (QExpr (Sql92SelectExpressionSyntax select) s)) -> next) -> QF select db s next    QArbitraryJoin :: Projectible (Sql92SelectExpressionSyntax select) r                  => QM select db (QNested s) r@@ -85,6 +85,15 @@                 (a -> TablePrefix -> (Maybe (Sql92SelectGroupingSyntax select), grouping)) ->                 QM select db (QNested s) a ->                 (grouping -> next) -> QF select db s next++  -- Force the building of a select statement, using the given builder+  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+ deriving instance Functor (QF select db s)  type QM select db s = F (QF select db s)@@ -101,13 +110,14 @@  data QField s ty   = QField-  { qFieldTblName :: T.Text+  { qFieldShouldQualify :: Bool+  , qFieldTblName :: T.Text   , qFieldName    :: T.Text }   deriving (Show, Eq, Ord) -data QAssignment fieldName expr s+newtype QAssignment fieldName expr s   = QAssignment [(fieldName, expr)]-  deriving (Show, Eq, Ord)+  deriving (Show, Eq, Ord, Monoid)  -- * QGenExpr type @@ -471,6 +481,19 @@     (,,,,,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c               <*> project' p mkE d <*> project' p mkE e <*> project' p mkE f               <*> project' p mkE g <*> project' p mkE h++instance Beamable t => ProjectibleWithPredicate AnyType T.Text (t (QField s)) where+  project' _ mutateM a =+    zipBeamFieldsM (\(Columnar' f) _ ->+                      Columnar' <$> project' (Proxy @AnyType) mutateM f) a a+instance Beamable t => ProjectibleWithPredicate AnyType T.Text (t (Nullable (QField s))) where+  project' _ mutateM a =+    zipBeamFieldsM (\(Columnar' f) _ ->+                      Columnar' <$> project' (Proxy @AnyType) mutateM f) a a+instance ProjectibleWithPredicate AnyType T.Text (QField s a) where+  project' _ mutateM (QField q tbl f) =+    fmap (\f' -> QField q tbl (f' ""))+         (mutateM (Proxy @(QField s a)) (\_ -> f)) -- This is kind of a hack  project :: Projectible syntax a => a -> WithExprContext [ syntax ] project = sequenceA . DList.toList . execWriter . project' (Proxy @AnyType) (\_ e -> tell (DList.singleton e) >> pure e)

@@ -1,12 +1,11 @@ module Database.Beam.Query.Operator-  ( -- ** General-purpose operators-    (&&.), (||.), not_, div_, mod_+  ( SqlBool -  , like_, similarTo_+    -- ** General-purpose operators+  , (&&.), (||.), not_, div_, mod_+  , (&&?.), (||?.), sqlNot_ -  , isTrue_, isNotTrue_-  , isFalse_, isNotFalse_-  , isUnknown_, isNotUnknown_+  , like_, similarTo_    , concat_   ) where@@ -19,6 +18,14 @@  import qualified Data.Text as T +-- | Phantom type representing a SQL /Tri-state/ boolean -- true, false, and unknown+--+-- This type has no values because it cannot be sent to or retrieved+-- from the database directly. Use 'isTrue_', 'isFalse_',+-- 'isNotTrue_', 'isNotFalse_', 'isUnknown_', 'isNotUnknown_', and+-- `unknownAs_` to retrieve the corresponding 'Bool' value.+data SqlBool+ -- | SQL @AND@ operator (&&.) :: IsSql92ExpressionSyntax syntax       => QGenExpr context syntax s Bool@@ -33,9 +40,23 @@       -> QGenExpr context syntax s Bool (||.) = qBinOpE orE -infixr 3 &&.-infixr 2 ||.+-- | SQL @AND@ operator for 'SqlBool'+(&&?.) :: IsSql92ExpressionSyntax syntax+       => QGenExpr context syntax s SqlBool+       -> QGenExpr context syntax s SqlBool+       -> QGenExpr context syntax s SqlBool+(&&?.) = qBinOpE andE +-- | SQL @OR@ operator+(||?.) :: IsSql92ExpressionSyntax syntax+       => QGenExpr context syntax s SqlBool+       -> QGenExpr context syntax s SqlBool+       -> QGenExpr context syntax s SqlBool+(||?.) = qBinOpE orE++infixr 3 &&., &&?.+infixr 2 ||., ||?.+ -- | SQL @LIKE@ operator like_ ::   ( IsSqlExpressionSyntaxStringType syntax text@@ -52,6 +73,8 @@ similarTo_ (QExpr scrutinee) (QExpr search) =   QExpr (liftA2 similarToE scrutinee search) +infix 4 `like_`, `similarTo_`+ -- | SQL @NOT@ operator not_ :: forall syntax context s.         IsSql92ExpressionSyntax syntax@@ -59,47 +82,26 @@      -> QGenExpr context syntax s Bool not_ (QExpr a) = QExpr (fmap notE a) +-- | SQL @NOT@ operator, but operating on 'SqlBool' instead+sqlNot_ :: forall syntax context s.+           IsSql92ExpressionSyntax syntax+        => QGenExpr context syntax s SqlBool+        -> QGenExpr context syntax s SqlBool+sqlNot_ (QExpr a) = QExpr (fmap notE a)+ -- | SQL @/@ operator div_ :: (Integral a, IsSql92ExpressionSyntax syntax)      => QGenExpr context syntax s a -> QGenExpr context syntax s a      -> QGenExpr context syntax s a div_ = qBinOpE divE +infixl 7 `div_`, `mod_`+ -- | SQL @%@ operator mod_ :: (Integral a, IsSql92ExpressionSyntax syntax)      => QGenExpr context syntax s a -> QGenExpr context syntax s a      -> QGenExpr context syntax s a mod_ = qBinOpE modE---- | SQL @IS TRUE@ operator-isTrue_ :: IsSql92ExpressionSyntax syntax-        => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isTrue_ (QExpr s) = QExpr (fmap isTrueE s)---- | SQL @IS NOT TRUE@ operator-isNotTrue_ :: IsSql92ExpressionSyntax syntax-           => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isNotTrue_ (QExpr s) = QExpr (fmap isNotTrueE s)---- | SQL @IS FALSE@ operator-isFalse_ :: IsSql92ExpressionSyntax syntax-         => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isFalse_ (QExpr s) = QExpr (fmap isFalseE s)---- | SQL @IS NOT FALSE@ operator-isNotFalse_ :: IsSql92ExpressionSyntax syntax-            => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isNotFalse_ (QExpr s) = QExpr (fmap isNotFalseE s)---- | SQL @IS UNKNOWN@ operator-isUnknown_ :: IsSql92ExpressionSyntax syntax-           => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isUnknown_ (QExpr s) = QExpr (fmap isUnknownE s)---- | SQL @IS NOT UNKNOWN@ operator-isNotUnknown_ :: IsSql92ExpressionSyntax syntax-              => QGenExpr context syntax s a -> QGenExpr context syntax s Bool-isNotUnknown_ (QExpr s) = QExpr (fmap isNotUnknownE s)  -- | SQL @CONCAT@ function concat_ :: IsSql99ConcatExpressionSyntax syntax

@@ -1,3 +1,5 @@+{-# LANGUAGE UndecidableInstances #-}+ -- | Defines classen 'SqlEq' and 'SqlOrd' that can be used to perform equality --   and comparison operations on certain expressions. --@@ -22,6 +24,15 @@   , SqlOrd(..), SqlOrdQuantified(..)   , QQuantified(..) +  , HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)+  , HasTableEquality, HasTableEqualityNullable++  , isTrue_, isNotTrue_+  , isFalse_, isNotFalse_+  , isUnknown_, isNotUnknown_+  , unknownAs_, sqlBool_+  , possiblyNullBool_+   , anyOf_, anyIn_   , allOf_, allIn_ @@ -35,30 +46,86 @@  import Database.Beam.Schema.Tables import Database.Beam.Backend.SQL+import Database.Beam.Backend.SQL.AST (Expression)+import Database.Beam.Backend.SQL.Builder (SqlSyntaxBuilder)  import Control.Applicative import Control.Monad.State  import Data.Maybe+import Data.Proxy+import Data.Kind+import Data.Word+import Data.Int+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 expr s r   = QQuantified (Sql92ExpressionQuantifierSyntax expr) (WithExprContext expr) +-- | 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_ :: IsSql92ExpressionSyntax syntax+        => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isTrue_ (QExpr s) = QExpr (fmap isTrueE s)++-- | SQL @IS NOT TRUE@ operator+isNotTrue_ :: IsSql92ExpressionSyntax syntax+           => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isNotTrue_ (QExpr s) = QExpr (fmap isNotTrueE s)++-- | SQL @IS FALSE@ operator+isFalse_ :: IsSql92ExpressionSyntax syntax+         => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isFalse_ (QExpr s) = QExpr (fmap isFalseE s)++-- | SQL @IS NOT FALSE@ operator+isNotFalse_ :: IsSql92ExpressionSyntax syntax+            => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isNotFalse_ (QExpr s) = QExpr (fmap isNotFalseE s)++-- | SQL @IS UNKNOWN@ operator+isUnknown_ :: IsSql92ExpressionSyntax syntax+           => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isUnknown_ (QExpr s) = QExpr (fmap isUnknownE s)++-- | SQL @IS NOT UNKNOWN@ operator+isNotUnknown_ :: IsSql92ExpressionSyntax syntax+              => QGenExpr context syntax s SqlBool -> QGenExpr context syntax 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_ :: IsSql92ExpressionSyntax syntax+           => Bool -> QGenExpr context syntax s SqlBool -> QGenExpr context syntax 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 syntax s SqlBool -> QGenExpr context syntax s (Maybe Bool)+possiblyNullBool_ (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 r select expr db.-   ( ThreadRewritable (QNested s) r-   , ProjectibleInSelectSyntax select r-   , IsSql92SelectSyntax select+  :: forall s a select expr db.+   ( IsSql92SelectSyntax select    , IsSql92ExpressionSyntax expr    , HasQBuilder select    , Sql92ExpressionSelectSyntax expr ~ select )-  => Q select db (QNested s) r-  -> QQuantified expr s (WithRewrittenThread (QNested s) s r)+  => Q select db (QNested s) (QExpr (Sql92SelectExpressionSyntax select) (QNested s) a)+  -> QQuantified expr s a allOf_ s = QQuantified quantifyOverAll (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))  -- | A 'QQuantified' representing a SQL @ALL(..)@ for use with a@@ -71,22 +138,20 @@    . ( IsSql92ExpressionSyntax expr )   => [QExpr expr s a]   -> QQuantified expr s a-allIn_ es = QQuantified quantifyOverAll (rowE <$> mapM (\(QExpr e) -> e) es)+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 r select expr db.-   ( ThreadRewritable (QNested s) r-   , ProjectibleInSelectSyntax select r-   , IsSql92SelectSyntax select+  :: forall s a select expr db.+   ( IsSql92SelectSyntax select    , IsSql92ExpressionSyntax expr    , HasQBuilder select    , Sql92ExpressionSelectSyntax expr ~ select )-  => Q select db (QNested s) r-  -> QQuantified expr s (WithRewrittenThread (QNested s) s r)+  => Q select db (QNested s) (QExpr (Sql92SelectExpressionSyntax select) (QNested s) a)+  -> QQuantified expr s a anyOf_ s = QQuantified quantifyOverAny (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))  -- | A 'QQuantified' representing a SQL @ANY(..)@ for use with a@@ -99,7 +164,7 @@    . ( IsSql92ExpressionSyntax expr )   => [QExpr expr s a]   -> QQuantified expr s a-anyIn_ es = QQuantified quantifyOverAny (rowE <$> mapM (\(QExpr e) -> e) es)+anyIn_ es = QQuantified quantifyOverAny (quantifierListE <$> mapM (\(QExpr e) -> e) es)  -- | SQL @BETWEEN@ clause between_ :: IsSql92ExpressionSyntax syntax@@ -117,72 +182,158 @@ in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False))) in_ (QExpr row) options = QExpr (inE <$> row <*> mapM (\(QExpr o) -> o) options) +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+  -- | 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+  -- | 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 -  (==*.), (/=*.) :: a -> quantified -> expr Bool+  -- | 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 expression syntax+class (IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool) =>+  HasSqlEqualityCheck syntax a where++  sqlEqE, sqlNeqE :: Proxy a -> syntax -> syntax -> syntax+  sqlEqE _ = eqE Nothing+  sqlNeqE _ = neqE Nothing++  -- | Tri-state equality+  sqlEqTriE, sqlNeqTriE :: Proxy a -> syntax -> syntax -> syntax+  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 syntax a, CanCheckMaybeEquality a) => HasSqlEqualityCheck syntax (Maybe a) where+  sqlEqE _ a b = eqMaybeE a b (sqlEqE (Proxy @a) a b)+  sqlNeqE _ a b = neqMaybeE a b (sqlNeqE (Proxy @a) a b)++instance HasSqlEqualityCheck syntax a => HasSqlEqualityCheck syntax (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 expression syntax+class HasSqlEqualityCheck syntax a => HasSqlQuantifiedEqualityCheck syntax a where+  sqlQEqE, sqlQNeqE :: Proxy a -> Maybe (Sql92ExpressionQuantifierSyntax syntax)+                    -> syntax -> syntax -> syntax+  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 IsSql92ExpressionSyntax syntax =>+instance ( IsSql92ExpressionSyntax syntax, HasSqlEqualityCheck syntax a ) =>   SqlEq (QGenExpr context syntax s) (QGenExpr context syntax s a) where -  (==.) = qBinOpE (eqE Nothing)-  (/=.) = qBinOpE (neqE Nothing)+  (==.) = qBinOpE (sqlEqE (Proxy @a))+  (/=.) = qBinOpE (sqlNeqE (Proxy @a)) +  (==?.) = qBinOpE (sqlEqTriE (Proxy @a))+  (/=?.) = qBinOpE (sqlNeqTriE (Proxy @a))+ -- | Two arbitrary expressions can be quantifiably compared for equality.-instance IsSql92ExpressionSyntax syntax =>+instance ( IsSql92ExpressionSyntax syntax, HasSqlQuantifiedEqualityCheck syntax a ) =>   SqlEqQuantified (QGenExpr context syntax s) (QQuantified syntax s a) (QGenExpr context syntax s a) where -  a ==*. QQuantified q b = qBinOpE (eqE (Just q)) a (QExpr b)-  a /=*. QQuantified q b = qBinOpE (neqE (Just q)) a (QExpr b)+  a ==*. QQuantified q b = qBinOpE (sqlQEqE (Proxy @a) (Just q)) a (QExpr b)+  a /=*. QQuantified q b = qBinOpE (sqlQNeqE (Proxy @a) (Just q)) a (QExpr b) +-- | Constraint synonym to check if two tables can be compared for equality+type HasTableEquality expr tbl =+  (FieldsFulfillConstraint (HasSqlEqualityCheck expr) tbl, Beamable tbl)+type HasTableEqualityNullable expr tbl =+  (FieldsFulfillConstraintNullable (HasSqlEqualityCheck expr) tbl, Beamable tbl)+ -- | Compare two arbitrary 'Beamable' types containing 'QGenExpr's for equality.-instance ( IsSql92ExpressionSyntax syntax+instance ( IsSql92ExpressionSyntax syntax, FieldsFulfillConstraint (HasSqlEqualityCheck syntax) tbl          , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool          , Beamable tbl ) =>          SqlEq (QGenExpr context syntax s) (tbl (QGenExpr context syntax s)) where    a ==. b = let (_, e) = runState (zipBeamFieldsM-                                   (\x'@(Columnar' x) (Columnar' y) ->+                                   (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->                                        do modify (\expr ->                                                     case expr of                                                       Nothing -> Just $ x ==. y                                                       Just expr' -> Just $ expr' &&. x ==. y)-                                          return x') a b) Nothing+                                          return x') (withConstraints @(HasSqlEqualityCheck syntax) `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' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->+                                        do modify (\expr ->+                                                     case expr of+                                                       Nothing -> Just $ x ==?. y+                                                       Just expr' -> Just $ expr' &&?. x ==?. y)+                                           return x') (withConstraints @(HasSqlEqualityCheck syntax) `alongsideTable` a) b) Nothing+            in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e+  a /=?. b = sqlNot_ (a ==?. b)+ instance ( IsSql92ExpressionSyntax syntax+         , FieldsFulfillConstraintNullable (HasSqlEqualityCheck syntax) tbl          , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool          , Beamable tbl)     => SqlEq (QGenExpr context syntax s) (tbl (Nullable (QGenExpr context syntax s))) where    a ==. b = let (_, e) = runState (zipBeamFieldsM-                                      (\x'@(Columnar' x) (Columnar' y) -> do+                                      (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) -> do                                           modify (\expr ->                                                     case expr of                                                       Nothing -> Just $ x ==. y                                                       Just expr' -> Just $ expr' &&. x ==. y)-                                          return x') a b) Nothing+                                          return x')+                                      (withNullableConstraints @(HasSqlEqualityCheck syntax) `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' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->+                                        do modify (\expr ->+                                                     case expr of+                                                       Nothing -> Just $ x ==?. y+                                                       Just expr' -> Just $ expr' &&?. x ==?. y)+                                           return x') (withNullableConstraints @(HasSqlEqualityCheck syntax) `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@@ -191,12 +342,12 @@ --   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 SqlEq expr e => SqlOrd expr e | e -> expr where+class SqlOrd expr e | e -> expr where    (<.), (>.), (<=.), (>=.) :: e -> e -> expr Bool  -- | Class for things which can be /quantifiably/ compared.-class (SqlOrd expr e, SqlEqQuantified expr quantified e) =>+class SqlOrd expr e =>   SqlOrdQuantified expr quantified e | e -> expr quantified where    (<*.), (>*.), (<=*.), (>=*.) :: e -> quantified  -> expr Bool@@ -215,3 +366,83 @@   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 HasSqlEqualityCheck Expression Text+instance HasSqlEqualityCheck Expression Integer+instance HasSqlEqualityCheck Expression Int+instance HasSqlEqualityCheck Expression Int8+instance HasSqlEqualityCheck Expression Int16+instance HasSqlEqualityCheck Expression Int32+instance HasSqlEqualityCheck Expression Int64+instance HasSqlEqualityCheck Expression Word+instance HasSqlEqualityCheck Expression Word8+instance HasSqlEqualityCheck Expression Word16+instance HasSqlEqualityCheck Expression Word32+instance HasSqlEqualityCheck Expression Word64+instance HasSqlEqualityCheck Expression Double+instance HasSqlEqualityCheck Expression Float+instance HasSqlEqualityCheck Expression Bool+instance HasSqlEqualityCheck Expression UTCTime+instance HasSqlEqualityCheck Expression LocalTime+instance HasSqlEqualityCheck Expression Day+instance HasSqlEqualityCheck Expression TimeOfDay++instance HasSqlQuantifiedEqualityCheck Expression Text+instance HasSqlQuantifiedEqualityCheck Expression Integer+instance HasSqlQuantifiedEqualityCheck Expression Int+instance HasSqlQuantifiedEqualityCheck Expression Int8+instance HasSqlQuantifiedEqualityCheck Expression Int16+instance HasSqlQuantifiedEqualityCheck Expression Int32+instance HasSqlQuantifiedEqualityCheck Expression Int64+instance HasSqlQuantifiedEqualityCheck Expression Word+instance HasSqlQuantifiedEqualityCheck Expression Word8+instance HasSqlQuantifiedEqualityCheck Expression Word16+instance HasSqlQuantifiedEqualityCheck Expression Word32+instance HasSqlQuantifiedEqualityCheck Expression Word64+instance HasSqlQuantifiedEqualityCheck Expression Double+instance HasSqlQuantifiedEqualityCheck Expression Float+instance HasSqlQuantifiedEqualityCheck Expression Bool+instance HasSqlQuantifiedEqualityCheck Expression UTCTime+instance HasSqlQuantifiedEqualityCheck Expression LocalTime+instance HasSqlQuantifiedEqualityCheck Expression Day+instance HasSqlQuantifiedEqualityCheck Expression TimeOfDay++instance HasSqlEqualityCheck SqlSyntaxBuilder Text+instance HasSqlEqualityCheck SqlSyntaxBuilder Integer+instance HasSqlEqualityCheck SqlSyntaxBuilder Int+instance HasSqlEqualityCheck SqlSyntaxBuilder Int8+instance HasSqlEqualityCheck SqlSyntaxBuilder Int16+instance HasSqlEqualityCheck SqlSyntaxBuilder Int32+instance HasSqlEqualityCheck SqlSyntaxBuilder Int64+instance HasSqlEqualityCheck SqlSyntaxBuilder Word+instance HasSqlEqualityCheck SqlSyntaxBuilder Word8+instance HasSqlEqualityCheck SqlSyntaxBuilder Word16+instance HasSqlEqualityCheck SqlSyntaxBuilder Word32+instance HasSqlEqualityCheck SqlSyntaxBuilder Word64+instance HasSqlEqualityCheck SqlSyntaxBuilder Double+instance HasSqlEqualityCheck SqlSyntaxBuilder Float+instance HasSqlEqualityCheck SqlSyntaxBuilder Bool+instance HasSqlEqualityCheck SqlSyntaxBuilder UTCTime+instance HasSqlEqualityCheck SqlSyntaxBuilder LocalTime+instance HasSqlEqualityCheck SqlSyntaxBuilder Day+instance HasSqlEqualityCheck SqlSyntaxBuilder TimeOfDay++instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Text+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Integer+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int8+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int16+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int32+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int64+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word8+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word16+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word32+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word64+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Double+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Float+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Bool+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder UTCTime+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder LocalTime+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Day+instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder TimeOfDay

@@ -37,7 +37,7 @@ --   for more information type OneToMany db s one many =   forall syntax.-  ( IsSql92SelectSyntax syntax+  ( IsSql92SelectSyntax syntax, HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey one)   , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool ) =>   one (QExpr (Sql92SelectExpressionSyntax syntax) s) ->   Q syntax db s (many (QExpr (Sql92SelectExpressionSyntax syntax) s))@@ -52,7 +52,7 @@ --   for more information type OneToManyOptional db s tbl rel =   forall syntax.-  ( IsSql92SelectSyntax syntax+  ( IsSql92SelectSyntax syntax, HasTableEqualityNullable (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)   , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool   , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) SqlNull ) =>   tbl (QExpr (Sql92SelectExpressionSyntax syntax) s) ->@@ -64,7 +64,8 @@ oneToMany_, oneToOne_   :: ( IsSql92SelectSyntax syntax      , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool-     , Database db+     , Database be db+     , HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)      , Table tbl, Table rel )   => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch (many) -}   -> (rel (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey tbl (QExpr (Sql92SelectExpressionSyntax syntax) s))@@ -82,7 +83,8 @@   :: ( IsSql92SelectSyntax syntax      , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool      , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) SqlNull-     , Database db+     , HasTableEqualityNullable (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)+     , Database be db      , Table tbl, Table rel )   => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch -}   -> (rel (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey tbl (Nullable (QExpr (Sql92SelectExpressionSyntax syntax) s)))@@ -130,7 +132,7 @@ --   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual> --   for more indformation. manyToMany_-  :: ( Database db, Table joinThrough+  :: ( Database be db, Table joinThrough      , Table left, Table right      , Sql92SelectSanityCheck syntax      , IsSql92SelectSyntax syntax@@ -152,7 +154,7 @@ --   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual> --   for more indformation. manyToManyPassthrough_-  :: ( Database db, Table joinThrough+  :: ( Database be db, Table joinThrough      , Table left, Table right      , Sql92SelectSanityCheck syntax      , IsSql92SelectSyntax syntax

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.Beam.Query.SQL92     ( buildSql92Query' ) where@@ -25,6 +26,18 @@ andE' Nothing (Just y) = Just y andE' (Just x) (Just y) = Just (andE x y) +newtype PreserveLeft a b = PreserveLeft { unPreserveLeft :: (a, b) }+instance ProjectibleWithPredicate c syntax b => ProjectibleWithPredicate c syntax (PreserveLeft a b) where+  project' p f (PreserveLeft (a, b)) =+    PreserveLeft . (a,) <$> project' p f b++type SelectStmtFn select+  =  Sql92SelectSelectTableSyntax select+ -> [Sql92SelectOrderingSyntax select]+ -> Maybe Integer {-^ LIMIT -}+ -> Maybe Integer {-^ OFFSET -}+ -> select+ data QueryBuilder select   = QueryBuilder   { qbNextTblRef :: Int@@ -49,8 +62,10 @@   SelectBuilderTopLevel ::     { sbLimit, sbOffset :: Maybe Integer     , sbOrdering        :: [ Sql92SelectOrderingSyntax syntax ]-    , sbTable           :: SelectBuilder syntax db a } ->-    SelectBuilder syntax db a+    , sbTable           :: SelectBuilder syntax db a+    , sbSelectFn        :: Maybe (SelectStmtFn syntax)+                        -- ^ Which 'SelectStmtFn' to use to build this select. If 'Nothing', use the default+    } -> SelectBuilder syntax db a  sbContainsSetOperation :: SelectBuilder syntax db a -> Bool sbContainsSetOperation (SelectBuilderSelectSyntax contains _ _) = contains@@ -74,13 +89,13 @@ buildSelect :: ( IsSql92SelectSyntax syntax                , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) a ) =>                TablePrefix -> SelectBuilder syntax db a -> syntax-buildSelect _ (SelectBuilderTopLevel limit offset ordering (SelectBuilderSelectSyntax _ _ table)) =-    selectStmt table ordering limit offset-buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderQ proj (QueryBuilder _ from where_))) =-    selectStmt (selectTableStmt Nothing (projExprs (defaultProjection pfx proj)) from where_ Nothing Nothing) ordering limit offset-buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderGrouping proj (QueryBuilder _ from where_) grouping having distinct)) =-    selectStmt (selectTableStmt distinct (projExprs (defaultProjection pfx proj)) from where_ grouping having) ordering limit offset-buildSelect pfx x = buildSelect pfx (SelectBuilderTopLevel Nothing Nothing [] x)+buildSelect _ (SelectBuilderTopLevel limit offset ordering (SelectBuilderSelectSyntax _ _ table) selectStmt') =+    (fromMaybe selectStmt selectStmt') table ordering limit offset+buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderQ proj (QueryBuilder _ from where_)) selectStmt') =+    (fromMaybe selectStmt selectStmt') (selectTableStmt Nothing (projExprs (defaultProjection pfx proj)) from where_ Nothing Nothing) ordering limit offset+buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderGrouping proj (QueryBuilder _ from where_) grouping having distinct) selectStmt') =+    (fromMaybe selectStmt selectStmt') (selectTableStmt distinct (projExprs (defaultProjection pfx proj)) from where_ grouping having) ordering limit offset+buildSelect pfx x = buildSelect pfx (SelectBuilderTopLevel Nothing Nothing [] x Nothing)  selectBuilderToTableSource :: ( Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax                               , IsSql92SelectSyntax syntax@@ -112,26 +127,26 @@ sbProj (SelectBuilderQ proj _) = proj sbProj (SelectBuilderGrouping proj _ _ _ _) = proj sbProj (SelectBuilderSelectSyntax _ proj _) = proj-sbProj (SelectBuilderTopLevel _ _ _ sb) = sbProj sb+sbProj (SelectBuilderTopLevel _ _ _ sb _) = sbProj sb  setSelectBuilderProjection :: Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) b =>                               SelectBuilder syntax db a -> b -> SelectBuilder syntax db b setSelectBuilderProjection (SelectBuilderQ _ q) proj = SelectBuilderQ proj q setSelectBuilderProjection (SelectBuilderGrouping _ q grouping having d) proj = SelectBuilderGrouping proj q grouping having d setSelectBuilderProjection (SelectBuilderSelectSyntax containsSetOp _ q) proj = SelectBuilderSelectSyntax containsSetOp proj q-setSelectBuilderProjection (SelectBuilderTopLevel limit offset ord sb) proj =-    SelectBuilderTopLevel limit offset ord (setSelectBuilderProjection sb proj)+setSelectBuilderProjection (SelectBuilderTopLevel limit offset ord sb s) proj =+    SelectBuilderTopLevel limit offset ord (setSelectBuilderProjection sb proj) s  limitSelectBuilder, offsetSelectBuilder :: Integer -> SelectBuilder syntax db a -> SelectBuilder syntax db a-limitSelectBuilder limit (SelectBuilderTopLevel limit' offset ordering tbl) =-    SelectBuilderTopLevel (Just $ maybe limit (min limit) limit') offset ordering tbl-limitSelectBuilder limit x = SelectBuilderTopLevel (Just limit) Nothing [] x+limitSelectBuilder limit (SelectBuilderTopLevel limit' offset ordering tbl build) =+    SelectBuilderTopLevel (Just $ maybe limit (min limit) limit') offset ordering tbl build+limitSelectBuilder limit x = SelectBuilderTopLevel (Just limit) Nothing [] x Nothing -offsetSelectBuilder offset (SelectBuilderTopLevel Nothing offset' ordering tbl) =-    SelectBuilderTopLevel Nothing (Just $ offset + fromMaybe 0 offset') ordering tbl-offsetSelectBuilder offset (SelectBuilderTopLevel (Just limit) offset' ordering tbl) =-    SelectBuilderTopLevel (Just $ max 0 (limit - offset)) (Just $ offset + fromMaybe 0 offset') ordering tbl-offsetSelectBuilder offset x = SelectBuilderTopLevel Nothing (Just offset) [] x+offsetSelectBuilder offset (SelectBuilderTopLevel Nothing offset' ordering tbl build) =+    SelectBuilderTopLevel Nothing (Just $ offset + fromMaybe 0 offset') ordering tbl build+offsetSelectBuilder offset (SelectBuilderTopLevel (Just limit) offset' ordering tbl build) =+    SelectBuilderTopLevel (Just $ max 0 (limit - offset)) (Just $ offset + fromMaybe 0 offset') ordering tbl build+offsetSelectBuilder offset x = SelectBuilderTopLevel Nothing (Just offset) [] x Nothing  exprWithContext :: TablePrefix -> WithExprContext a -> a exprWithContext pfx = ($ nextTblPfx pfx)@@ -156,29 +171,29 @@ buildInnerJoinQuery     :: forall select s table      . (Beamable table, IsSql92SelectSyntax select)-    => TablePrefix -> T.Text -> TableSettings table+    => TablePrefix -> (TablePrefix -> T.Text -> Sql92SelectFromSyntax select) -> TableSettings table     -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))-    -> QueryBuilder select -> (table (QExpr (Sql92SelectExpressionSyntax select) s), QueryBuilder select)-buildInnerJoinQuery tblPfx tbl tblSettings mkOn qb =+    -> QueryBuilder select -> (T.Text, table (QExpr (Sql92SelectExpressionSyntax select) s), QueryBuilder select)+buildInnerJoinQuery tblPfx mkFrom tblSettings mkOn qb =   let qb' = QueryBuilder (tblRef + 1) from' where'       tblRef = qbNextTblRef qb       newTblNm = tblPfx <> fromString (show tblRef)-      newSource = fromTable (tableNamed tbl) (Just newTblNm)+      newSource = mkFrom (nextTblPfx tblPfx) newTblNm       (from', where') =         case qbFrom qb of           Nothing -> (Just newSource, andE' (qbWhere qb) (exprWithContext tblPfx <$> mkOn newTbl))           Just oldFrom -> (Just (innerJoin oldFrom newSource (exprWithContext tblPfx <$> mkOn newTbl)), qbWhere qb)        newTbl = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (\_ -> fieldE (qualifiedField newTblNm (_fieldName f))))) tblSettings-  in (newTbl, qb')+  in (newTblNm, newTbl, qb')  nextTbl :: (IsSql92SelectSyntax select, Beamable table)         => QueryBuilder select-        -> TablePrefix -> T.Text -> TableSettings table+        -> TablePrefix -> TableSettings table         -> ( table (QExpr (Sql92SelectExpressionSyntax select) s)            , T.Text            , QueryBuilder select )-nextTbl qb tblPfx _ tblSettings =+nextTbl qb tblPfx tblSettings =   let tblRef = qbNextTblRef qb       newTblNm = tblPfx <> fromString (show tblRef)       newTbl = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (\_ -> fieldE (qualifiedField newTblNm (_fieldName f))))) tblSettings@@ -270,21 +285,20 @@             doJoined =                 let sb' = case sb of                             SelectBuilderQ {} ->-                                SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb reproj)+                                SelectBuilderTopLevel Nothing Nothing ordering sb Nothing                             SelectBuilderGrouping {} ->-                                SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb reproj)+                                SelectBuilderTopLevel Nothing Nothing ordering sb Nothing                             SelectBuilderSelectSyntax {} ->-                                SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb reproj)-                            SelectBuilderTopLevel Nothing Nothing [] sb' ->-                                SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb' reproj)-                            SelectBuilderTopLevel (Just 0) (Just 0) [] sb' ->-                                SelectBuilderTopLevel (Just 0) (Just 0) ordering (setSelectBuilderProjection sb' reproj)+                                SelectBuilderTopLevel Nothing Nothing ordering sb Nothing+                            SelectBuilderTopLevel Nothing Nothing [] sb' build ->+                                SelectBuilderTopLevel Nothing Nothing ordering sb' build+                            SelectBuilderTopLevel Nothing (Just 0) [] sb' build ->+                                SelectBuilderTopLevel Nothing (Just 0) ordering sb' build                             SelectBuilderTopLevel {}                                 | (proj'', qb) <- selectBuilderToQueryBuilder tblPfx sb ->-                                    SelectBuilderTopLevel Nothing Nothing (exprWithContext tblPfx (mkOrdering proj'')) (SelectBuilderQ proj'' qb)+                                    SelectBuilderTopLevel Nothing Nothing (exprWithContext tblPfx (mkOrdering proj'')) (SelectBuilderQ proj'' qb) Nothing                                 | otherwise -> error "buildQuery (Free (QOrderBy ...)): query inspected expression" -                    (reproj, _) = selectBuilderToQueryBuilder tblPfx sb                     (joinedProj, qb) = selectBuilderToQueryBuilder tblPfx sb'                 in buildJoinedQuery (next joinedProj) qb         in case next proj of@@ -294,19 +308,19 @@                  ordering ->                      case sb of                        SelectBuilderQ {} ->-                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj')+                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj') Nothing                        SelectBuilderGrouping {} ->-                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj')+                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj') Nothing                        SelectBuilderSelectSyntax {} ->-                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj')-                       SelectBuilderTopLevel Nothing Nothing [] sb' ->-                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb' proj')-                       SelectBuilderTopLevel (Just 0) (Just 0) [] sb' ->-                           SelectBuilderTopLevel (Just 0) (Just 0) ordering (setSelectBuilderProjection sb' proj')+                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb proj') Nothing+                       SelectBuilderTopLevel Nothing Nothing [] sb' build ->+                           SelectBuilderTopLevel Nothing Nothing ordering (setSelectBuilderProjection sb' proj') build+                       SelectBuilderTopLevel (Just 0) (Just 0) [] sb' build ->+                           SelectBuilderTopLevel (Just 0) (Just 0) ordering (setSelectBuilderProjection sb' proj') build                        SelectBuilderTopLevel {}                            | (proj'', qb) <- selectBuilderToQueryBuilder tblPfx sb,                              Pure proj''' <- next proj'' ->-                               SelectBuilderTopLevel Nothing Nothing (exprWithContext tblPfx (mkOrdering proj'')) (SelectBuilderQ proj''' qb)+                               SelectBuilderTopLevel Nothing Nothing (exprWithContext tblPfx (mkOrdering proj'')) (SelectBuilderQ proj''' qb) Nothing                            | otherwise -> error "buildQuery (Free (QOrderBy ...)): query inspected expression"              _ -> doJoined @@ -321,7 +335,7 @@                -- Windowing makes this automatically a top-level (this prevents aggregates from being added directly)                case setSelectBuilderProjection sb x' of                  sb'@SelectBuilderTopLevel {} -> sb'-                 sb' -> SelectBuilderTopLevel Nothing Nothing [] sb'+                 sb' -> SelectBuilderTopLevel Nothing Nothing [] sb' Nothing              _       ->                let (x', qb) = selectBuilderToQueryBuilder tblPfx (setSelectBuilderProjection sb projection)                in buildJoinedQuery (next x') qb@@ -354,6 +368,23 @@     buildQuery (Free (QExcept all_ left right next)) =       buildTableCombination (exceptTable all_) left right next +    buildQuery (Free (QForceSelect selectStmt' over next)) =+      let sb = buildQuery (fromF over)+          x = sbProj sb++          selectStmt'' = selectStmt' (sbProj sb)++          sb' = case sb of+                  SelectBuilderTopLevel { sbSelectFn = Nothing } ->+                    sb { sbSelectFn = Just selectStmt'' }+                  SelectBuilderTopLevel { sbSelectFn = Just {} } ->+                    error "Force select too hard"+                  _ -> SelectBuilderTopLevel Nothing Nothing [] sb (Just selectStmt'')+      in case next (sbProj sb') of+           Pure x' -> setSelectBuilderProjection sb' x'+           _ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb'+                in buildJoinedQuery (next x') qb+     tryBuildGuardsOnly :: forall s x.                           Free (QF select db s) x                        -> Maybe (Sql92SelectExpressionSyntax select)@@ -407,16 +438,16 @@                         Projectible (Sql92ProjectionExpressionSyntax projSyntax) x =>                         Free (QF select db s) x -> QueryBuilder select -> SelectBuilder select db x     buildJoinedQuery (Pure x) qb = SelectBuilderQ x qb-    buildJoinedQuery (Free (QAll tbl tblSettings on next)) qb =-        let (newTbl, qb') = buildInnerJoinQuery tblPfx tbl tblSettings on qb-        in buildJoinedQuery (next newTbl) qb'+    buildJoinedQuery (Free (QAll mkFrom tblSettings on next)) qb =+        let (newTblNm, newTbl, qb') = buildInnerJoinQuery tblPfx mkFrom tblSettings on qb+        in buildJoinedQuery (next (newTblNm, newTbl)) qb'     buildJoinedQuery (Free (QArbitraryJoin q mkJoin on next)) qb =       case fromF q of-        Free (QAll dbTblNm dbTblSettings on' next')-          | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblNm dbTblSettings,+        Free (QAll mkDbFrom dbTblSettings on' next')+          | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblSettings,             Nothing <- exprWithContext tblPfx <$> on' newTbl,-            Pure proj <- next' newTbl ->-            let newSource = fromTable (tableNamed dbTblNm) (Just newTblNm)+            Pure proj <- next' (newTblNm, newTbl) ->+            let newSource = mkDbFrom (nextTblPfx tblPfx) newTblNm                 on'' = exprWithContext tblPfx <$> on proj                 (from', where') =                   case qbFrom qb' of@@ -443,10 +474,10 @@     buildJoinedQuery (Free (QTwoWayJoin a b mkJoin on next)) qb =       let (aProj, aSource, qb') =             case fromF a of-              Free (QAll dbTblNm dbTblSettings on' next')-                | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblNm dbTblSettings,-                  Nothing <- on' newTbl, Pure proj <- next' newTbl ->-                    (proj, fromTable (tableNamed dbTblNm) (Just newTblNm), qb')+              Free (QAll mkDbFrom dbTblSettings on' next')+                | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblSettings,+                  Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->+                    (proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb')                a -> let sb = buildQuery a                        tblSource = buildSelect tblPfx sb@@ -458,10 +489,10 @@            (bProj, bSource, qb'') =             case fromF b of-              Free (QAll dbTblNm dbTblSettings on' next')-                | (newTbl, newTblNm, qb'') <- nextTbl qb' tblPfx dbTblNm dbTblSettings,-                  Nothing <- on' newTbl, Pure proj <- next' newTbl ->-                    (proj, fromTable (tableNamed dbTblNm) (Just newTblNm), qb'')+              Free (QAll mkDbFrom dbTblSettings on' next')+                | (newTbl, newTblNm, qb'') <- nextTbl qb' tblPfx dbTblSettings,+                  Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->+                    (proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb'')                b -> let sb = buildQuery b                        tblSource = buildSelect tblPfx sb@@ -494,7 +525,7 @@           -> (forall a'. Projectible (Sql92SelectExpressionSyntax select) a' => Free (QF select db s) a' -> (a' -> Free (QF select db s) x) -> SelectBuilder select db x)           -> SelectBuilder select db x     onlyQ (Free (QAll entityNm entitySettings mkOn next)) f =-      f (Free (QAll entityNm entitySettings mkOn Pure)) next+      f (Free (QAll entityNm entitySettings mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)     onlyQ (Free (QArbitraryJoin entity mkJoin mkOn next)) f =       f (Free (QArbitraryJoin entity mkJoin mkOn Pure)) next     onlyQ (Free (QTwoWayJoin a b mkJoin mkOn next)) f =@@ -519,4 +550,6 @@       f (Free (QAggregate mkAgg q' Pure)) next     onlyQ (Free (QDistinct d q' next)) f =       f (Free (QDistinct d q' Pure)) next+    onlyQ (Free (QForceSelect s over next)) f =+      f (Free (QForceSelect s over Pure)) next     onlyQ _ _ = error "impossible"

@@ -1,5 +1,5 @@ module Database.Beam.Query.Types-  ( Q, QExpr, QGenExpr(..), QExprToIdentity, QWindow, QWindowFrame+  ( Q, QExpr, QGenExpr(..), QExprToIdentity, QExprToField, QWindow, QWindowFrame    , Projectible, Aggregation @@ -34,6 +34,27 @@   ( QExprToIdentity a, QExprToIdentity b, QExprToIdentity c, QExprToIdentity d, QExprToIdentity e, QExprToIdentity f   , QExprToIdentity g, QExprToIdentity h ) type instance QExprToIdentity (Vector n a) = Vector n (QExprToIdentity a)++-- TODO can this be unified with QExprToIdentity?+type family QExprToField x+type instance QExprToField (table (QGenExpr context syntax s)) = table (QField s)+type instance QExprToField (table (Nullable (QGenExpr context syntax s))) = table (Nullable (QField s))+type instance QExprToField (QGenExpr ctxt syntax s a) = QField s a+type instance QExprToField () = ()+type instance QExprToField (a, b) = (QExprToField a, QExprToField b)+type instance QExprToField (a, b, c) = (QExprToField a, QExprToField b, QExprToField c)+type instance QExprToField (a, b, c, d) = (QExprToField a, QExprToField b, QExprToField c, QExprToField d)+type instance QExprToField (a, b, c, d, e) = (QExprToField a, QExprToField b, QExprToField c, QExprToField d, QExprToField e)+type instance QExprToField (a, b, c, d, e, f) =+  ( QExprToField a, QExprToField b, QExprToField c, QExprToField d+  , QExprToField e, QExprToField f )+type instance QExprToField (a, b, c, d, e, f, g) =+  ( QExprToField a, QExprToField b, QExprToField c, QExprToField d+  , QExprToField e, QExprToField f, QExprToField g )+type instance QExprToField (a, b, c, d, e, f, g, h) =+  ( QExprToField a, QExprToField b, QExprToField c, QExprToField d+  , QExprToField e, QExprToField f, QExprToField g, QExprToField h)+type instance QExprToField (Vector n a) = Vector n (QExprToField a)  class IsSql92SelectSyntax selectSyntax => HasQBuilder selectSyntax where   buildSqlQuery :: Projectible (Sql92SelectExpressionSyntax selectSyntax) a =>

@@ -25,11 +25,18 @@               rightLenses = gTableLenses (Proxy :: Proxy b) (\f -> lensToHere (\(a :*: b) -> (a :*:) <$> f b)) instance Generic (t m) => GTableLenses t m (K1 R x) (K1 R (LensFor (t m) x)) where     gTableLenses _ lensToHere = K1 (LensFor (\f -> lensToHere (\(K1 x) -> K1 <$> f x)))-instance ( Generic (PrimaryKey rel m)-         , Generic (PrimaryKey rel (Lenses t m))-         , GTableLenses t m (Rep (PrimaryKey rel m)) (Rep (PrimaryKey rel (Lenses t m))) ) =>-         GTableLenses t m (K1 R (PrimaryKey rel m)) (K1 R (PrimaryKey rel (Lenses t m))) where-    gTableLenses _ lensToHere = K1 (to (gTableLenses (Proxy :: Proxy (Rep (PrimaryKey rel m))) (\f -> lensToHere (\(K1 x) -> K1 . to <$> f (from x)))))++instance ( Generic (sub m)+         , Generic (sub (Lenses t m))+         , GTableLenses t m (Rep (sub m)) (Rep (sub (Lenses t m))) ) =>+         GTableLenses t m (K1 R (sub m)) (K1 R (sub (Lenses t m))) where+    gTableLenses _ lensToHere = K1 (to (gTableLenses (Proxy :: Proxy (Rep (sub m))) (\f -> lensToHere (\(K1 x) -> K1 . to <$> f (from x)))))++instance ( Generic (sub (Nullable m))+         , Generic (sub (Nullable (Lenses t m)))+         , GTableLenses t m (Rep (sub (Nullable m))) (Rep (sub (Nullable (Lenses t m))))) =>+         GTableLenses t m (K1 R (sub (Nullable m))) (K1 R (sub (Nullable (Lenses t m)))) where+    gTableLenses _ lensToHere = K1 (to (gTableLenses (Proxy :: Proxy (Rep (sub (Nullable m)))) (\f -> lensToHere (\(K1 x) -> K1 . to <$> f (from x)))))  tableLenses' :: ( lensType ~ Lenses t f                 , Generic (t lensType)

@@ -31,6 +31,7 @@      -- * Columnar and Column Tags     , Columnar, C, Columnar'(..)+    , ComposeColumnar(..)     , Nullable, TableField(..)     , Exposed     , fieldName@@ -41,14 +42,17 @@     , FieldsFulfillConstraintNullable     , WithConstraint(..)     , TagReducesTo(..), ReplaceBaseTag+    , withConstrainedFields, withConstraints+    , withNullableConstrainedFields, withNullableConstraints      -- * Tables     , Table(..), Beamable(..)-    , Retaggable(..)+    , Retaggable(..), (:*:)(..) -- Reexported for use with 'alongsideTable'     , defTblFieldSettings     , tableValuesNeeded     , pk-    , allBeamValues, changeBeamRep )+    , allBeamValues, changeBeamRep+    , alongsideTable )     where  import           Database.Beam.Backend.Types@@ -79,10 +83,14 @@ --   is named 'f', each field must be of the type of 'f' applied to some type --   for which an 'IsDatabaseEntity' instance exists. --+--   The 'be' type parameter is necessary so that the compiler can+--   ensure that backend-specific entities only work on the proper+--   backend.+-- --   Entities are documented under [the corresponding --   section](Database.Beam.Schema#entities) and in the --   [manual](http://tathougies.github.io/beam/user-guide/databases/)-class Database db where+class Database be db where      -- | Default derived function. Do not implement this yourself.     --@@ -142,7 +150,7 @@ --   only want to rename one table. You can do -- -- > dbModification { tbl1 = modifyTable (\oldNm -> "NewTableName") tableModification }-dbModification :: forall f be db. Database db => DatabaseModification f be  db+dbModification :: forall f be db. Database be db => DatabaseModification f be db dbModification = runIdentity $                  zipTables (Proxy @be) (\_ _ -> pure (EntityModification id)) (undefined :: DatabaseModification f be db) (undefined :: DatabaseModification f be db) @@ -172,7 +180,7 @@ -- >        table1 = modifyTable (\_ -> "Table_1") (tableModification { table1Field1 = "first_name" } -- >      } withDbModification :: forall db be entity-                    . Database db+                    . Database be db                    => db (entity be db)                    -> DatabaseModification (entity be db) be db                    -> db (entity be db)@@ -211,7 +219,7 @@  class RenamableWithRule mod where   renamingFields :: (Text -> Text) -> mod-instance Database db => RenamableWithRule (db (EntityModification (DatabaseEntity be db) be)) where+instance Database be db => RenamableWithRule (db (EntityModification (DatabaseEntity be db) be)) where   renamingFields renamer =     runIdentity $     zipTables (Proxy @be) (\_ _ -> pure (renamingFields renamer))@@ -428,6 +436,9 @@ --   simply wraps 'Columnar f a' newtype Columnar' f a = Columnar' (Columnar f a) +-- | Like 'Data.Functor.Compose', but with an intermediate 'Columnar'+newtype ComposeColumnar f g a = ComposeColumnar (f (Columnar g a))+ -- | Metadata for a field of type 'ty' in 'table'. -- --   Essentially a wrapper over the field name, but with a phantom type@@ -546,6 +557,11 @@ changeBeamRep :: Beamable table => (forall a. Columnar' f a -> Columnar' g a) -> table f -> table g changeBeamRep f tbl = runIdentity (zipBeamFieldsM (\x _ -> return (f x)) tbl tbl) +alongsideTable :: Beamable tbl => tbl f -> tbl g -> tbl (Columnar' f :*: Columnar' g)+alongsideTable a b =+  runIdentity $+  zipBeamFieldsM (\x y -> pure (Columnar' (x :*: y))) a b+ class Retaggable f x | x -> f where   type Retag (tag :: (* -> *) -> * -> *) x :: * @@ -641,6 +657,24 @@ instance FieldsFulfillConstraintNullable c t =>     GFieldsFulfillConstraint c (K1 Generic.R (t (Nullable Exposed))) (K1 Generic.R (t (Nullable Identity))) (K1 Generic.R (t (Nullable (WithConstraint c)))) where   gWithConstrainedFields _ _ (K1 x) = K1 (to (gWithConstrainedFields (Proxy @c) (Proxy @(Rep (t (Nullable Exposed)))) (from x)))++withConstrainedFields :: forall c tbl+                       . FieldsFulfillConstraint c tbl => tbl Identity -> tbl (WithConstraint c)+withConstrainedFields =+  to . gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl Exposed))) . from++withConstraints :: forall c tbl. (Beamable tbl, FieldsFulfillConstraint c tbl) => tbl (WithConstraint c)+withConstraints =+  withConstrainedFields (changeBeamRep (\_ -> Columnar' undefined) tblSkeleton)++withNullableConstrainedFields :: forall c tbl+                               . FieldsFulfillConstraintNullable c tbl => tbl (Nullable Identity) -> tbl (Nullable (WithConstraint c))+withNullableConstrainedFields =+  to . gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl (Nullable Exposed)))) . from++withNullableConstraints ::  forall c tbl. (Beamable tbl, FieldsFulfillConstraintNullable c tbl) => tbl (Nullable (WithConstraint c))+withNullableConstraints =+  withNullableConstrainedFields (changeBeamRep (\_ -> Columnar' undefined) tblSkeleton)  type FieldsFulfillConstraint (c :: * -> Constraint) t =   ( Generic (t (WithConstraint c)), Generic (t Identity), Generic (t Exposed)

@@ -1,5 +1,5 @@ The MIT License (MIT)-Copyright (c) 2015, 2016 Travis Athougies+Copyright (c) 2015-2018 Travis Athougies and the Beam Authors  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                beam-core-version:             0.6.0.0+version:             0.7.0.0 synopsis:            Type-safe, feature-complete SQL query and manipulation interface for Haskell description:         Beam is a Haskell library for type-safe querying and manipulation of SQL databases.                      Beam is modular and supports various backends. In order to use beam, you will need to use@@ -18,7 +18,7 @@ maintainer:          travis@athougies.net category:            Database build-type:          Simple-cabal-version:       >=1.18+cabal-version:       1.18 bug-reports:         https://github.com/tathougies/beam/issues extra-doc-files:     ChangeLog.md @@ -58,13 +58,14 @@                        mtl          >=2.1     && <2.3,                        microlens    >=0.4     && <0.5,                        ghc-prim     >=0.5     && <0.6,-                       free         >=4.12    && <4.13,+                       free         >=4.12    && <5.1,                        dlist        >=0.7.1.2 && <0.9,                        time         >=1.6     && <1.10,                        hashable     >=1.1     && <1.3,                        network-uri  >=2.6     && <2.7,                        containers   >=0.5     && <0.6,-                       vector-sized >=0.5     && <0.7+                       vector-sized >=0.5     && <0.7,+                       tagged       >=0.8     && <0.9   Default-language:    Haskell2010   default-extensions:  ScopedTypeVariables, OverloadedStrings, GADTs, RecursiveDo, FlexibleInstances, FlexibleContexts, TypeFamilies,                        GeneralizedNewtypeDeriving, RankNTypes, TupleSections, ConstraintKinds, StandaloneDeriving, TypeOperators,

@@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE AllowAmbiguousTypes #-}  module Database.Beam.Test.SQL   ( tests ) where@@ -42,8 +43,14 @@                   , updateCurrent                   , updateNullable -                  , noEmptyIns ]+                  , noEmptyIns +                  -- Regressions for github issues+                  , testGroup "Regression tests"+                    [ gh70OrderByInFirstJoinCausesIncorrectProjection+                    ]+                  ]+ -- | Ensure simple select selects the right fields  simpleSelect :: TestTree@@ -254,18 +261,22 @@                           , selectLimit = Nothing, selectOffset = Nothing                           , selectOrdering = [] } <-            pure $ select $-           do (age, maxNameLength) <- aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $+           do (age, maxNameLength) <- aggregate_ (\e -> ( group_ (_employeeAge e)+                                                        , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $                                       all_ (_employees employeeDbSettings)               guard_ (maxNameLength >. 42)               pure (age, maxNameLength)           Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "age"), Just "res0" )-                                        , ( ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ], Just "res1") ]+                                        , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ]+                                                               , ExpressionValue (Value (0 :: Int)) ], Just "res1" ) ]          selectWhere @?= Nothing          selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField t0 "age") ])-         selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ])-                                                             (ExpressionValue (Value (42 :: Int))))+         selectHaving @?= Just (ExpressionCompOp ">" Nothing+                                (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ]+                                                    , ExpressionValue (Value (0 :: Int)) ])+                                (ExpressionValue (Value (42 :: Int))))      aggregateInJoin =       testCase "Aggregate in JOIN" $@@ -374,18 +385,24 @@                           , selectOrdering = [] } <-            pure $ select $            filter_ (\(_, l) -> l <. 10 ||. l >. 20) $-           aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $+           aggregate_ (\e -> ( group_ (_employeeAge e)+                             , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $            limit_ 10 (all_ (_employees employeeDbSettings))          Just (FromTable (TableFromSubSelect subselect) (Just t0)) <- pure selectFrom -         selectProjection @?= ProjExprs [(ExpressionFieldName (QualifiedField t0 "res3"),Just "res0"),(ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0"))], Just "res1")]+         selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "res3"),Just "res0")+                                        , (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0"))]+                                                              , ExpressionValue (Value (0 :: Int)) ], Just "res1")+                                        ]          selectWhere @?= Nothing          selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "res3")])          selectHaving @?= Just (ExpressionBinOp "OR" (ExpressionCompOp "<" Nothing-                                                      (ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ])+                                                      (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ]+                                                                          , ExpressionValue (Value (0 :: Int)) ])                                                       (ExpressionValue (Value (10 :: Int))))                                                      (ExpressionCompOp ">" Nothing-                                                      (ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ])+                                                      (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ]+                                                                          , ExpressionValue (Value (0 :: Int)) ])                                                       (ExpressionValue (Value (20 :: Int)))))           selectLimit subselect @?= Just 10@@ -415,7 +432,7 @@                           , selectOrdering = [] } <-            pure $ select $            do (lastName, firstNameLength) <--                  filter_ (\(_, charLength) -> charLength >. 10) $+                  filter_ (\(_, charLength) -> fromMaybe_ 0 charLength >. 10) $                   aggregate_ (\e -> (group_ (_employeeLastName e), max_ (charLength_ (_employeeFirstName e)))) $                   limit_ 10 (all_ (_employees employeeDbSettings))               role <- relatedBy_ (_roles employeeDbSettings) (\r -> _roleName r ==. lastName)@@ -443,7 +460,8 @@            pure subselect          Just (FromTable (TableFromSubSelect employeesSelect) (Just t0')) <- pure selectFrom          selectWhere @?= Nothing-         selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))])+         selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))]+                                                                                 , ExpressionValue (Value (0 :: Int)) ])                                                              (ExpressionValue (Value (10 :: Int))))          selectGrouping @?= Just (Grouping [ (ExpressionFieldName (QualifiedField t0' "res1")) ])          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0' "res1"), Just "res0" )@@ -475,7 +493,8 @@            do role <- all_ (_roles employeeDbSettings)               (lastName, firstNameLength) <-                   filter_ (\(_, charLength) -> charLength >. 10) $-                  aggregate_ (\e -> (group_ (_employeeLastName e), max_ (charLength_ (_employeeFirstName e)))) $+                  aggregate_ (\e -> ( group_ (_employeeLastName e)+                                    , fromMaybe_ 0 $ max_ (charLength_ (_employeeFirstName e))) ) $                   limit_ 10 (all_ (_employees employeeDbSettings))               guard_ (_roleName role ==. lastName)               pure (firstNameLength, role, lastName)@@ -505,7 +524,9 @@          selectHaving @?= Nothing          selectGrouping @?= Just (Grouping [ (ExpressionFieldName (QualifiedField t0' "res1")) ])          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0' "res1"), Just "res0" )-                                        , ( ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))], Just "res1" ) ]+                                        , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))]+                                                               , ExpressionValue (Value (0 :: Int)) ]+                                          , Just "res1" ) ]           Select { selectTable = SelectTable { .. }, selectLimit = Just 10                 , selectOffset = Nothing, selectOrdering = [] } <-@@ -718,7 +739,7 @@                       , selectLimit = Nothing, selectOffset = Nothing                       , selectOrdering = [] } <-        pure $ select $-       do (age, maxFirstNameLength) <- filter_ (\(_, nameLength) -> nameLength >=. 20) $+       do (age, maxFirstNameLength) <- filter_ (\(_, nameLength) -> fromMaybe_ 0 nameLength >=. 20) $                                        aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $                                        all_ (_employees employeeDbSettings)           role <- all_ (_roles employeeDbSettings)@@ -743,7 +764,10 @@                                     , (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))], Just "res1") ]      selectWhere @?= Nothing      selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "age")])-     selectHaving @?= Just (ExpressionCompOp ">=" Nothing (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))]) (ExpressionValue (Value (20 :: Int))))+     selectHaving @?= Just (ExpressionCompOp ">=" Nothing+                            (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))]+                                                , ExpressionValue (Value (0 :: Int)) ])+                            (ExpressionValue (Value (20 :: Int))))  -- | Ensure that isJustE and isNothingE work correctly for simple types @@ -778,23 +802,29 @@          Just (FromTable (TableNamed "departments") (Just depts)) <- pure selectFrom -        let andE = ExpressionBinOp "AND"+        let andE = ExpressionBinOp "AND"; orE = ExpressionBinOp "OR"             eqE = ExpressionCompOp "==" Nothing++            maybeEqE a b = ExpressionCase [ (andE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value True))+                                          , (orE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value False))+                                          ]+                                          (eqE a b)+             nameCond = eqE (ExpressionFieldName (QualifiedField depts "name"))                            (ExpressionFieldName (QualifiedField depts "name"))-            firstNameCond = eqE (ExpressionFieldName (QualifiedField depts "head__first_name"))+            firstNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__first_name"))                                 (ExpressionFieldName (QualifiedField depts "head__first_name"))-            lastNameCond = eqE (ExpressionFieldName (QualifiedField depts "head__last_name"))-                               (ExpressionFieldName (QualifiedField depts "head__last_name"))-            createdCond = eqE (ExpressionFieldName (QualifiedField depts "head__created"))-                              (ExpressionFieldName (QualifiedField depts "head__created"))+            lastNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__last_name"))+                                    (ExpressionFieldName (QualifiedField depts "head__last_name"))+            createdCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__created"))+                                   (ExpressionFieldName (QualifiedField depts "head__created"))         selectWhere @?= andE (andE (andE nameCond firstNameCond) lastNameCond) createdCond     tableExprToTableLiteral =      testCase "Equality comparison between table expression and table literal" $      do now <- getCurrentTime -        let exp = DepartmentT "Sales" (EmployeeId (Just "Jane") (Just "Smith") (Just (Auto (Just now))))+        let exp = DepartmentT "Sales" (EmployeeId (Just "Jane") (Just "Smith") (Just now))         SqlSelect Select { selectTable = SelectTable { selectWhere = Just selectWhere, selectFrom } } <- pure $ select $ do           d <- all_ (_departments employeeDbSettings)           guard_ (d ==. val_ exp)@@ -802,16 +832,22 @@          Just (FromTable (TableNamed "departments") (Just depts)) <- pure selectFrom -        let andE = ExpressionBinOp "AND"+        let andE = ExpressionBinOp "AND"; orE = ExpressionBinOp "OR"             eqE = ExpressionCompOp "==" Nothing++            maybeEqE a b = ExpressionCase [ (andE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value True))+                                          , (orE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value False))+                                          ]+                                          (eqE a b)+             nameCond = eqE (ExpressionFieldName (QualifiedField depts "name"))                            (ExpressionValue (Value ("Sales" :: Text)))-            firstNameCond = eqE (ExpressionFieldName (QualifiedField depts "head__first_name"))-                                (ExpressionValue (Value ("Jane" :: Text)))-            lastNameCond = eqE (ExpressionFieldName (QualifiedField depts "head__last_name"))-                               (ExpressionValue (Value ("Smith" :: Text)))-            createdCond = eqE (ExpressionFieldName (QualifiedField depts "head__created"))-                              (ExpressionValue (Value now))+            firstNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__first_name"))+                                     (ExpressionValue (Value ("Jane" :: Text)))+            lastNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__last_name"))+                                    (ExpressionValue (Value ("Smith" :: Text)))+            createdCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__created"))+                                  (ExpressionValue (Value now))         selectWhere @?= andE (andE (andE nameCond firstNameCond) lastNameCond) createdCond  -- | Ensure related_ generates the correct ON conditions@@ -1099,7 +1135,7 @@   do curTime <- getCurrentTime       let employeeKey :: PrimaryKey EmployeeT (Nullable Identity)-         employeeKey = EmployeeId (Just "John") (Just "Smith") (Just (Auto (Just curTime)))+         employeeKey = EmployeeId (Just "John") (Just "Smith") (Just curTime)       SqlUpdate Update { .. } <-        pure $ update (_departments employeeDbSettings)@@ -1126,3 +1162,190 @@           pure e        selectWhere @?= Just (ExpressionValue (Value False))++-- | ORDER BY in first join causes incorrect projection in subquery++gh70OrderByInFirstJoinCausesIncorrectProjection :: TestTree+gh70OrderByInFirstJoinCausesIncorrectProjection =+  testGroup "#70: ORDER BY as first join causes incorrect projection"+    [ testCase "Simple" simple+    , testCase "Grouping" grouping+    , testCase "Top-level OFFSET 0" topLevelOffs0+    ]+  where+    employees = "t0"; roles = "t1"++    eqE = ExpressionCompOp "==" Nothing+    andE = ExpressionBinOp "AND"++    firstNameCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__first_name"))+                        (ExpressionFieldName (QualifiedField employees "res0"))+    lastNameCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__last_name"))+                       (ExpressionFieldName (QualifiedField employees "res1"))+    createdCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__created"))+                      (ExpressionFieldName (QualifiedField employees "res7"))++    simple =+      do let employeesMakingSixFigures =+               orderBy_ (\e -> desc_ (_employeeAge e)) $+               filter_ (\e -> _employeeSalary e >=. 100000) $+               all_ (_employees employeeDbSettings)++             richEmployeesAndRoles = do+               employee <- employeesMakingSixFigures+               role <- all_ (_roles employeeDbSettings)+               guard_ (_roleForEmployee role `references_` employee)+               pure (_roleName role, employee)++         SqlSelect Select { selectTable = SelectTable { .. }+                          , .. } <-+           pure $ select richEmployeesAndRoles++         selectProjection @?= ProjExprs+             [ (ExpressionFieldName (QualifiedField roles "name")    , Just "res0")+             , (ExpressionFieldName (QualifiedField employees "res0"), Just "res1")+             , (ExpressionFieldName (QualifiedField employees "res1"), Just "res2")+             , (ExpressionFieldName (QualifiedField employees "res2"), Just "res3")+             , (ExpressionFieldName (QualifiedField employees "res3"), Just "res4")+             , (ExpressionFieldName (QualifiedField employees "res4"), Just "res5")+             , (ExpressionFieldName (QualifiedField employees "res5"), Just "res6")+             , (ExpressionFieldName (QualifiedField employees "res6"), Just "res7")+             , (ExpressionFieldName (QualifiedField employees "res7"), Just "res8")+             ]+         selectGrouping @?= Nothing+         selectOrdering @?= []+         selectLimit @?= Nothing+         selectOffset @?= Nothing+         selectHaving @?= Nothing++         selectWhere @?= Just (andE (andE firstNameCond lastNameCond) createdCond)++         Just (InnerJoin (FromTable (TableFromSubSelect subselect) (Just "t0"))+                         (FromTable (TableNamed "roles") (Just "t1"))+                         Nothing) <- pure selectFrom++         Select { selectTable = SelectTable { .. }+                , .. } <- pure subselect++         selectGrouping @?= Nothing+         selectLimit @?= Nothing+         selectOffset @?= Nothing+         selectHaving @?= Nothing+         selectOrdering @?= [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "age")) ]+         selectWhere @?= Just (ExpressionCompOp ">=" Nothing+                                 (ExpressionFieldName (QualifiedField "t0" "salary"))+                                 (ExpressionValue (Value (100000 :: Double))))++         selectProjection @?= ProjExprs+           [ (ExpressionFieldName (QualifiedField "t0" "first_name")   , Just "res0")+           , (ExpressionFieldName (QualifiedField "t0" "last_name")    , Just "res1")+           , (ExpressionFieldName (QualifiedField "t0" "phone_number") , Just "res2")+           , (ExpressionFieldName (QualifiedField "t0" "age")          , Just "res3")+           , (ExpressionFieldName (QualifiedField "t0" "salary")       , Just "res4")+           , (ExpressionFieldName (QualifiedField "t0" "hire_date")    , Just "res5")+           , (ExpressionFieldName (QualifiedField "t0" "leave_date")   , Just "res6")+           , (ExpressionFieldName (QualifiedField "t0" "created")      , Just "res7")+           ]++    grouping = do+      let employeeNamesWhoMakeSixFiguresOnAverage =+            orderBy_ (\(fn, _) -> desc_ fn) $+            filter_ (\(_, sl) -> sl >=. val_ 100000) $+            aggregate_ (\e -> ( group_ (_employeeFirstName e)+                              , fromMaybe_ 0 $ avg_ (_employeeSalary e) )) $+            all_ (_employees employeeDbSettings)++          richEmployeeNamesAndRoles = do+            (fn, sl) <- employeeNamesWhoMakeSixFiguresOnAverage+            role <- all_ (_roles employeeDbSettings)+            let EmployeeId roleForEmployee_firstName _ _ = _roleForEmployee role+            guard_ (roleForEmployee_firstName ==. fn)+            pure (_roleName role, fn, sl)++      SqlSelect Select { selectTable = SelectTable+                                       { selectQuantifier = Nothing+                                       , selectProjection = ProjExprs+                                           [ (ExpressionFieldName (QualifiedField "t1" "name"), Just "res0")+                                           , (ExpressionFieldName (QualifiedField "t0" "res0"), Just "res1")+                                           , (ExpressionFieldName (QualifiedField "t0" "res1"), Just "res2")+                                           ]+                                       , selectGrouping = Nothing, selectHaving = Nothing+                                       , selectWhere = Just selectWhere+                                       , selectFrom = Just (InnerJoin (FromTable (TableFromSubSelect Select+                                                                                 { selectTable =+                                                                                   SelectTable { selectQuantifier = Nothing+                                                                                               , selectWhere = Nothing+                                                                                               , .. }+                                                                                 , selectLimit = Nothing, selectOffset = Nothing+                                                                                 , selectOrdering = selectOrdering }) (Just "t0"))+                                                                    (FromTable (TableNamed "roles") (Just "t1"))+                                                                    Nothing) }+                       , selectOrdering = []+                       , selectLimit = Nothing , selectOffset = Nothing } <-+        pure $ select $ richEmployeeNamesAndRoles++      selectWhere @?= firstNameCond+      selectOrdering @?= [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "first_name")) ]+      selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField "t0" "first_name") ])+      selectHaving @?= Just (ExpressionCompOp ">=" Nothing+                              (ExpressionCoalesce+                               [ ExpressionAgg "AVG" Nothing+                                  [ ExpressionFieldName (QualifiedField "t0" "salary") ]+                               , ExpressionValue (Value (0 :: Double)) ])+                              (ExpressionValue (Value (100000 :: Double))))+      selectProjection @?= ProjExprs+        [ ( ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0" )+        , ( ExpressionCoalesce+            [ ExpressionAgg "AVG" Nothing+              [ ExpressionFieldName (QualifiedField "t0" "salary") ]+            , ExpressionValue (Value (0 :: Double)) ]+          , Just "res1" )+        ]++    topLevelOffs0 = do+      SqlSelect actual <-+         pure $ select $ do+           e <-  orderBy_ (\e -> desc_ (_employeeAge e)) $ offset_ 0 $+                 filter_ (\e -> _employeeSalary e >=. val_ 100000) $+                 all_ (_employees employeeDbSettings)+           role <- all_ (_roles employeeDbSettings)+           let EmployeeId roleForEmployee_firstName _ _ = _roleForEmployee role+           guard_ (roleForEmployee_firstName ==. _employeeFirstName e)+           pure (_roleName role, _employeeFirstName e)++      let expected =+            Select { selectTable = SelectTable+                     { selectQuantifier = Nothing+                     , selectProjection = ProjExprs+                       [ (ExpressionFieldName (QualifiedField "t1" "name"), Just "res0")+                       , (ExpressionFieldName (QualifiedField "t0" "res0"), Just "res1")+                       ]+                     , selectGrouping = Nothing, selectHaving = Nothing+                     , selectWhere = Just firstNameCond+                     , selectFrom = Just (InnerJoin (FromTable+                                                     (TableFromSubSelect Select+                                                       { selectTable = SelectTable+                                                         { selectQuantifier = Nothing+                                                         , selectProjection = ProjExprs+                                                           [ (ExpressionFieldName (QualifiedField "t0" "first_name")   , Just "res0")+                                                           , (ExpressionFieldName (QualifiedField "t0" "last_name")    , Just "res1")+                                                           , (ExpressionFieldName (QualifiedField "t0" "phone_number") , Just "res2")+                                                           , (ExpressionFieldName (QualifiedField "t0" "age")          , Just "res3")+                                                           , (ExpressionFieldName (QualifiedField "t0" "salary")       , Just "res4")+                                                           , (ExpressionFieldName (QualifiedField "t0" "hire_date")    , Just "res5")+                                                           , (ExpressionFieldName (QualifiedField "t0" "leave_date")   , Just "res6")+                                                           , (ExpressionFieldName (QualifiedField "t0" "created")      , Just "res7")+                                                           ]+                                                         , selectWhere = Just (ExpressionCompOp ">=" Nothing+                                                                               (ExpressionFieldName (QualifiedField "t0" "salary"))+                                                                               (ExpressionValue (Value (100000 :: Double))))+                                                         , selectFrom  = Just (FromTable (TableNamed "employees") (Just "t0"))+                                                         , selectGrouping = Nothing, selectHaving = Nothing }+                                                       , selectLimit = Nothing, selectOffset = Just 0+                                                       , selectOrdering = [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "age"))] }) (Just "t0"))+                                           (FromTable (TableNamed "roles") (Just "t1"))+                                           Nothing) }+                   , selectOrdering = []+                   , selectLimit = Nothing , selectOffset = Nothing }++      actual @?= expected

@@ -55,18 +55,18 @@   , _employeeHireDate  :: Columnar f UTCTime   , _employeeLeaveDate :: Columnar f (Maybe UTCTime) -  , _employeeCreated :: Columnar f (Auto UTCTime)+  , _employeeCreated :: Columnar f UTCTime   } deriving Generic instance Beamable EmployeeT instance Table EmployeeT where-  data PrimaryKey EmployeeT f = EmployeeId (Columnar f Text) (Columnar f Text) (Columnar f (Auto UTCTime))+  data PrimaryKey EmployeeT f = EmployeeId (Columnar f Text) (Columnar f Text) (Columnar f UTCTime)     deriving Generic   primaryKey e = EmployeeId (_employeeFirstName e) (_employeeLastName e) (_employeeCreated e) instance Beamable (PrimaryKey EmployeeT) deriving instance Show (TableSettings EmployeeT) deriving instance Eq (TableSettings EmployeeT)-deriving instance (Show (Columnar f Text), Show (Columnar f (Auto UTCTime))) => Show (PrimaryKey EmployeeT f)-deriving instance (Eq (Columnar f Text), Eq(Columnar f (Auto UTCTime))) => Eq (PrimaryKey EmployeeT f)+deriving instance (Show (Columnar f Text), Show (Columnar f UTCTime)) => Show (PrimaryKey EmployeeT f)+deriving instance (Eq (Columnar f Text), Eq (Columnar f  UTCTime)) => Eq (PrimaryKey EmployeeT f)  -- * Verify that the schema is generated properly @@ -117,14 +117,6 @@ roleTableSchema :: TableSettings RoleT roleTableSchema = defTblFieldSettings --- automaticNestedFieldsAreUnset :: TestTree--- automaticNestedFieldsAreUnset =---   testCase "Automatic fields are unset when nesting" $---   do _roleForEmployee roleTableSchema @?=---        EmployeeId (TableField "for_employee__first_name" (DummyField True False DummyFieldText))---                   (TableField "for_employee__last_name" (DummyField True False DummyFieldText))---                   (TableField "for_employee__created" (DummyField True False DummyFieldUTCTime))- -- * Ensure that fields of a nullable primary key are given the proper Maybe type  data DepartmentT f@@ -209,7 +201,7 @@     , _roles       :: f (TableEntity RoleT)     , _funny       :: f (TableEntity FunnyT) }     deriving Generic-instance Database EmployeeDb+instance Database be EmployeeDb  employeeDbSettings :: DatabaseSettings be EmployeeDb employeeDbSettings = defaultDbSettings