beam-core 0.8.0.0 → 0.9.0.0

raw patch · 30 files changed

+821/−379 lines, 30 filesdep ~basedep ~ghc-primdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, ghc-prim, hashable, mtl, text, vector-sized

API changes (from Hackage documentation)

Files

• ChangeLog.md +37/−1
• Database/Beam.hs +1/−1
• Database/Beam/Backend/Internal/Compat.hs +16/−0
• Database/Beam/Backend/SQL.hs +12/−10
• Database/Beam/Backend/SQL/AST.hs +8/−2
• Database/Beam/Backend/SQL/BeamExtensions.hs +97/−8
• Database/Beam/Backend/SQL/Builder.hs +11/−12
• Database/Beam/Backend/SQL/Row.hs +6/−5
• Database/Beam/Backend/SQL/SQL2003.hs +7/−6
• Database/Beam/Backend/SQL/SQL92.hs +39/−38
• Database/Beam/Backend/SQL/SQL99.hs +3/−2
• Database/Beam/Backend/Types.hs +3/−3
• Database/Beam/Backend/URI.hs +3/−6
• Database/Beam/Query.hs +176/−38
• Database/Beam/Query/Adhoc.hs +94/−0
• Database/Beam/Query/Aggregate.hs +9/−9
• Database/Beam/Query/CTE.hs +28/−16
• Database/Beam/Query/Combinators.hs +45/−26
• Database/Beam/Query/CustomSQL.hs +9/−10
• Database/Beam/Query/Extensions.hs +8/−8
• Database/Beam/Query/Internal.hs +15/−11
• Database/Beam/Query/Ord.hs +33/−15
• Database/Beam/Query/Relationships.hs +9/−9
• Database/Beam/Query/SQL92.hs +2/−6
• Database/Beam/Schema.hs +1/−1
• Database/Beam/Schema/Lenses.hs +2/−1
• Database/Beam/Schema/Tables.hs +90/−78
• beam-core.cabal +20/−10
• test/Database/Beam/Test/SQL.hs +32/−32
• test/Database/Beam/Test/Schema.hs +5/−15

@@ -1,3 +1,39 @@+# 0.9.0.0++## Removal of machine-dependent `Int`/`Word` instances++Beam now mandates that you use unambiguous integer types like `Int32`, `Int64`, or `Integer` instead of the machine-dependent `Int` or `Word`.+Custom type errors have been added to guide migration where required.++Combinators which previously returned `Int`, such as `countAll_` and `rowNumber_`, now match functions such as `count_` in returning any `Integral` type.+The type of these functions vary across databases and doesn't in general correspond to the `INTEGER` type.+(For example Postgres uses `bigint` for these.)++## `in_` on row values++Beam now supports using `in_` on row values, for backends which support it.+This fulfills the often requested ability to use `in_` on `PrimaryKey`s, e.g. ``primaryKey row `in_` [ ... ]``.++## Miscellaneous added features++ * Support for ad-hoc queries on tables which don't have a corresponding `Beamable` type+ * `HasInsertOnConflict` class for backends which support functionality similar to Postgres and SQLite's `INSERT ... ON CONFLICT`+ * Convenience functions `setEntitySchema` and `modifyEntitySchema`+ * Haskell-style conditionals `ifThenElse_` and `bool_`+ * Poly-kinded instances for `Data.Tagged.Tagged`+ * Variants of update functions which use tri-value `SqlBool`: `update'`, `save'`, `updateRow'`, `updateTableRow'`, and corresponding combinator `references'`+ * GHC 8.8 support++## Minor interface changes++ * Split `WithConstraint` apart, to support strict fields+ * `zipTables` supports `Applicative` actions instead of `Monad`++## Bug fixes++ * Database definition fields can be made strict+ * `decimalType` properly emits SQL 92 `DECIMAL` instead of `DOUBLE`+ # 0.8.0.0  ## Common table expressions@@ -71,7 +107,7 @@  ## Changes to parseOneField and peekField -Formerly, the `peekField` function would attemt to parse a field+Formerly, the `peekField` function would attempt to parse a field without advancing the column pointer, regardless of whether a field was successfully parsed. In order to support more efficient parsing, this has been changed. When `peekField` returns a `Just` value, then

@@ -5,7 +5,7 @@ --   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).+--   [manual](https://haskell-beam.github.io/beam). module Database.Beam      ( module Database.Beam.Query      , module Database.Beam.Schema

@@ -0,0 +1,16 @@+-- | This module contains utilities that backend writers can use to assist with+-- compatibility and breaking API changes.+--+-- Users should not need anything from this module.+module Database.Beam.Backend.Internal.Compat where++import GHC.TypeLits++-- | A type error directing the user to use an explicitly sized integers,+-- instead of 'Int' or 'Word'.+type PreferExplicitSize implicit explicit =+  'Text "The size of " ':<>:+  'ShowType implicit ':<>:+  'Text " is machine-dependent. Use an explicitly sized integer such as " ':<>:+  'ShowType explicit ':<>:+  'Text " instead."

@@ -1,3 +1,4 @@+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-} module Database.Beam.Backend.SQL   ( module Database.Beam.Backend.SQL.Row@@ -63,23 +64,24 @@   , BeamSqlBackendSupportsDataType   ) where -import Database.Beam.Backend.SQL.SQL2003-import Database.Beam.Backend.SQL.Row-import Database.Beam.Backend.SQL.Types-import Database.Beam.Backend.Types+import           Database.Beam.Backend.SQL.SQL2003+import           Database.Beam.Backend.SQL.Row+import           Database.Beam.Backend.SQL.Types+import           Database.Beam.Backend.Types -import Control.Monad.Cont-import Control.Monad.Except+import           Control.Monad.Cont+import           Control.Monad.Except import qualified Control.Monad.RWS.Lazy as Lazy import qualified Control.Monad.RWS.Strict as Strict-import Control.Monad.Reader+import           Control.Monad.Reader import qualified Control.Monad.State.Lazy as Lazy import qualified Control.Monad.Writer.Lazy as Lazy import qualified Control.Monad.State.Strict as Strict import qualified Control.Monad.Writer.Strict as Strict -import Data.Tagged (Tagged)-import Data.Text (Text)+import           Data.Kind (Type)+import           Data.Tagged (Tagged)+import           Data.Text (Text)  -- * MonadBeam class @@ -224,7 +226,7 @@       , Eq (BeamSqlBackendExpressionSyntax be)       ) => BeamSqlBackend be -type family BeamSqlBackendSyntax be :: *+type family BeamSqlBackendSyntax be :: Type  -- | Fake backend that cannot deserialize anything, but is useful for testing data MockSqlBackend syntax

@@ -6,6 +6,7 @@  import Prelude hiding (Ordering) +import Database.Beam.Backend.Internal.Compat import Database.Beam.Backend.SQL.SQL92 import Database.Beam.Backend.SQL.SQL99 import Database.Beam.Backend.SQL.SQL2003@@ -17,6 +18,7 @@ import Data.Word (Word16, Word32, Word64) import Data.Typeable import Data.Int+import GHC.TypeLits  data Command   = SelectCommand Select@@ -502,11 +504,9 @@   Value :: (Show a, Eq a, Typeable a) => a -> Value  #define VALUE_SYNTAX_INSTANCE(ty) instance HasSqlValueSyntax Value ty where { sqlValueSyntax = Value }-VALUE_SYNTAX_INSTANCE(Int) VALUE_SYNTAX_INSTANCE(Int16) VALUE_SYNTAX_INSTANCE(Int32) VALUE_SYNTAX_INSTANCE(Int64)-VALUE_SYNTAX_INSTANCE(Word) VALUE_SYNTAX_INSTANCE(Word16) VALUE_SYNTAX_INSTANCE(Word32) VALUE_SYNTAX_INSTANCE(Word64)@@ -521,6 +521,12 @@ VALUE_SYNTAX_INSTANCE(SqlNull) VALUE_SYNTAX_INSTANCE(Double) VALUE_SYNTAX_INSTANCE(Bool)++instance TypeError (PreferExplicitSize Int Int32) => HasSqlValueSyntax Value Int where+  sqlValueSyntax = Value++instance TypeError (PreferExplicitSize Word Word32) => HasSqlValueSyntax Value Word where+  sqlValueSyntax = Value  instance HasSqlValueSyntax Value x => HasSqlValueSyntax Value (Maybe x) where   sqlValueSyntax (Just x) = sqlValueSyntax x

@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableInstances #-} -- | Some functionality is useful enough to be provided across backends, but is -- not standardized. For example, many RDBMS systems provide ways of fetching@@ -10,24 +11,33 @@   ( MonadBeamInsertReturning(..)   , MonadBeamUpdateReturning(..)   , MonadBeamDeleteReturning(..)+  , BeamHasInsertOnConflict(..)    , SqlSerial(..)+  , onConflictUpdateInstead+  , onConflictUpdateAll   ) where -import Database.Beam.Backend-import Database.Beam.Query-import Database.Beam.Schema+import           Database.Beam.Backend+import           Database.Beam.Query+import           Database.Beam.Query.Internal+import           Database.Beam.Schema+import           Database.Beam.Schema.Tables -import Control.Monad.Identity-import Control.Monad.Cont-import Control.Monad.Except+import           Control.Monad.Cont+import           Control.Monad.Except+import           Control.Monad.Identity import qualified Control.Monad.RWS.Lazy as Lazy import qualified Control.Monad.RWS.Strict as Strict-import Control.Monad.Reader+import           Control.Monad.Reader import qualified Control.Monad.State.Lazy as Lazy-import qualified Control.Monad.Writer.Lazy as Lazy import qualified Control.Monad.State.Strict as Strict+import qualified Control.Monad.Writer.Lazy as Lazy import qualified Control.Monad.Writer.Strict as Strict+import           Data.Functor.Const+import           Data.Kind (Type)+import           Data.Proxy+import           Data.Semigroup  --import GHC.Generics @@ -133,3 +143,82 @@ instance (MonadBeamDeleteReturning be m, Monoid w)     => MonadBeamDeleteReturning be (Strict.RWST r w s m) where     runDeleteReturningList = lift . runDeleteReturningList++class BeamSqlBackend be => BeamHasInsertOnConflict be where+  -- | Specifies the kind of constraint that must be violated for the action to occur+  data SqlConflictTarget be (table :: (Type -> Type) -> Type) :: Type+  -- | What to do when an @INSERT@ statement inserts a row into the table @tbl@+  -- that violates a constraint.+  data SqlConflictAction be (table :: (Type -> Type) -> Type) :: Type++  insertOnConflict+    :: Beamable table+    => DatabaseEntity be db (TableEntity table)+    -> SqlInsertValues be (table (QExpr be s))+    -> SqlConflictTarget be table+    -> SqlConflictAction be table+    -> SqlInsert be table++  anyConflict :: SqlConflictTarget be table+  conflictingFields+    :: Projectible be proj+    => (table (QExpr be QInternal) -> proj)+    -> SqlConflictTarget be table+  conflictingFieldsWhere+    :: Projectible be proj+    => (table (QExpr be QInternal) -> proj)+    -> (forall s. table (QExpr be s) -> QExpr be s Bool)+    -> SqlConflictTarget be table++  onConflictDoNothing :: SqlConflictAction be table+  onConflictUpdateSet+    :: Beamable table+    => (forall s. table (QField s) -> table (QExpr be s) -> QAssignment be s)+    -> SqlConflictAction be table+  onConflictUpdateSetWhere+    :: Beamable table+    => (forall s. table (QField s) -> table (QExpr be s) -> QAssignment be s)+    -> (forall s. table (QField s) -> table (QExpr be s) -> QExpr be s Bool)+    -> SqlConflictAction be table++newtype InaccessibleQAssignment be = InaccessibleQAssignment+  { unInaccessibleQAssignment :: [(BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)]+  } deriving (Data.Semigroup.Semigroup, Monoid)++onConflictUpdateInstead+  :: forall be table proj+  .  ( BeamHasInsertOnConflict be+     , Beamable table+     , ProjectibleWithPredicate AnyType () (InaccessibleQAssignment be) proj+     )+  => (table (Const (InaccessibleQAssignment be)) -> proj)+  -> SqlConflictAction be table+onConflictUpdateInstead mkProj = onConflictUpdateSet mkAssignments+  where+    mkAssignments+      :: forall s+      .  table (QField s)+      -> table (QExpr be s)+      -> QAssignment be s+    mkAssignments table excluded = QAssignment $ unInaccessibleQAssignment $+      Strict.execWriter $ project'+        (Proxy @AnyType)+        (Proxy @((), InaccessibleQAssignment be))+        (\_ _ a -> Strict.tell a >> return a)+        (mkProj $ runIdentity $ zipBeamFieldsM mkAssignment table excluded)+    mkAssignment+      :: forall s a+      .  Columnar' (QField s) a+      -> Columnar' (QExpr be s) a+      -> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)+    mkAssignment (Columnar' field) (Columnar' value) =+      Identity $ Columnar' $ Const $+        InaccessibleQAssignment $ unQAssignment $ field <-. value++onConflictUpdateAll+  :: forall be table+  .  ( BeamHasInsertOnConflict be+     , Beamable table+     )+  => SqlConflictAction be table+onConflictUpdateAll = onConflictUpdateInstead id

@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Provides a syntax 'SqlSyntaxBuilder' that uses a --   'Data.ByteString.Builder.Builder' to construct SQL expressions as strings.@@ -18,8 +19,8 @@   , quoteSql   , renderSql ) where +import           Database.Beam.Backend.Internal.Compat import           Database.Beam.Backend.SQL---import           Database.Beam.Backend.Types  import           Control.Monad.IO.Class @@ -35,9 +36,7 @@ import           Data.Int import           Data.String import qualified Control.Monad.Fail as Fail-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif+import           GHC.TypeLits  -- | The main syntax. A wrapper over 'Builder' newtype SqlSyntaxBuilder@@ -57,12 +56,11 @@   a == b = toLazyByteString (buildSql a) == toLazyByteString (buildSql b)  instance Semigroup SqlSyntaxBuilder where-  (<>) = mappend+  SqlSyntaxBuilder a <> SqlSyntaxBuilder b =  SqlSyntaxBuilder (a <> b)  instance Monoid SqlSyntaxBuilder where   mempty = SqlSyntaxBuilder mempty-  mappend (SqlSyntaxBuilder a) (SqlSyntaxBuilder b) =-    SqlSyntaxBuilder (mappend a b)+  mappend = (<>)  instance IsSql92Syntax SqlSyntaxBuilder where   type Sql92SelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder@@ -433,7 +431,7 @@     varBitType prec = SqlSyntaxBuilder ("BIT VARYING" <> sqlOptPrec prec)      numericType prec = SqlSyntaxBuilder ("NUMERIC" <> sqlOptNumericPrec prec)-    decimalType prec = SqlSyntaxBuilder ("DOUBLE" <> sqlOptNumericPrec prec)+    decimalType prec = SqlSyntaxBuilder ("DECIMAL" <> sqlOptNumericPrec prec)      intType = SqlSyntaxBuilder "INT"     smallIntType = SqlSyntaxBuilder "SMALLINT"@@ -461,9 +459,6 @@ sqlOptNumericPrec (Just (prec, Just dec)) = "(" <> fromString (show prec) <> ", " <> fromString (show dec) <> ")"  -- TODO These instances are wrong (Text doesn't handle quoting for example)-instance HasSqlValueSyntax SqlSyntaxBuilder Int where-  sqlValueSyntax x = SqlSyntaxBuilder $-    byteString (fromString (show x)) instance HasSqlValueSyntax SqlSyntaxBuilder Int32 where   sqlValueSyntax x = SqlSyntaxBuilder $     byteString (fromString (show x))@@ -475,6 +470,10 @@     byteString (fromString (show x)) instance HasSqlValueSyntax SqlSyntaxBuilder SqlNull where   sqlValueSyntax _ = SqlSyntaxBuilder (byteString "NULL")++instance TypeError (PreferExplicitSize Int Int32) => HasSqlValueSyntax SqlSyntaxBuilder Int where+  sqlValueSyntax x = SqlSyntaxBuilder $+    byteString (fromString (show x))  renderSql :: SqlSyntaxBuilder -> String renderSql (SqlSyntaxBuilder b) = BL.unpack (toLazyByteString b)

@@ -3,6 +3,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PolyKinds #-}  module Database.Beam.Backend.SQL.Row   ( FromBackendRowF(..), FromBackendRowM(..)@@ -20,14 +21,13 @@ import           Control.Exception (Exception) import           Control.Monad.Free.Church import           Control.Monad.Identity+import           Data.Kind (Type) import           Data.Tagged import           Data.Typeable import           Data.Vector.Sized (Vector) import qualified Data.Vector.Sized as Vector -#if !MIN_VERSION_base(4, 12, 0)-import           Data.Proxy-#endif+import qualified Control.Monad.Fail as Fail  import           GHC.Generics import           GHC.TypeLits@@ -67,11 +67,12 @@     FromBackendRowM $     a >>= (\x -> let FromBackendRowM b' = b x in b') +instance Fail.MonadFail (FromBackendRowM be) where   fail = FromBackendRowM . liftF . FailParseWith .          BeamRowReadError Nothing . ColumnErrorInternal  instance Alternative (FromBackendRowM be) where-  empty   = fail "empty"+  empty   = Fail.fail "empty"   a <|> b =     FromBackendRowM (liftF (Alt a b id)) @@ -95,7 +96,7 @@   valuesNeeded :: Proxy be -> Proxy a -> Int   valuesNeeded _ _ = 1 -class GFromBackendRow be (exposed :: * -> *) rep where+class GFromBackendRow be (exposed :: Type -> Type) rep where   gFromBackendRow :: Proxy exposed -> FromBackendRowM be (rep ())   gValuesNeeded :: Proxy be -> Proxy exposed -> Proxy rep -> Int instance GFromBackendRow be e p => GFromBackendRow be (M1 t f e) (M1 t f p) where

@@ -25,6 +25,7 @@  import Database.Beam.Backend.SQL.SQL99 +import Data.Kind (Type) import Data.Text (Text)  type Sql2003SanityCheck syntax =@@ -36,7 +37,7 @@ class IsSql92FromSyntax from =>     IsSql2003FromSyntax from where -    type Sql2003FromSampleMethodSyntax from :: *+    type Sql2003FromSampleMethodSyntax from :: Type      fromTableSample :: Sql92FromTableSourceSyntax from                     -> Sql2003FromSampleMethodSyntax from@@ -54,7 +55,7 @@       , IsSql2003WindowFrameSyntax (Sql2003ExpressionWindowFrameSyntax expr) ) =>     IsSql2003ExpressionSyntax expr where -    type Sql2003ExpressionWindowFrameSyntax expr :: *+    type Sql2003ExpressionWindowFrameSyntax expr :: Type      overE :: expr           -> Sql2003ExpressionWindowFrameSyntax expr@@ -83,9 +84,9 @@  class IsSql2003WindowFrameBoundsSyntax (Sql2003WindowFrameBoundsSyntax frame) =>     IsSql2003WindowFrameSyntax frame where-    type Sql2003WindowFrameExpressionSyntax frame :: *-    type Sql2003WindowFrameOrderingSyntax frame :: *-    type Sql2003WindowFrameBoundsSyntax frame :: *+    type Sql2003WindowFrameExpressionSyntax frame :: Type+    type Sql2003WindowFrameOrderingSyntax frame :: Type+    type Sql2003WindowFrameBoundsSyntax frame :: Type      frameSyntax :: Maybe [Sql2003WindowFrameExpressionSyntax frame]                 -> Maybe [Sql2003WindowFrameOrderingSyntax frame]@@ -94,7 +95,7 @@  class IsSql2003WindowFrameBoundSyntax (Sql2003WindowFrameBoundsBoundSyntax bounds) =>     IsSql2003WindowFrameBoundsSyntax bounds where-    type Sql2003WindowFrameBoundsBoundSyntax bounds :: *+    type Sql2003WindowFrameBoundsBoundSyntax bounds :: Type     fromToBoundSyntax :: Sql2003WindowFrameBoundsBoundSyntax bounds                       -> Maybe (Sql2003WindowFrameBoundsBoundSyntax bounds)                       -> bounds

@@ -7,6 +7,7 @@ import Database.Beam.Backend.SQL.Row  import Data.Int+import Data.Kind (Type) import Data.Tagged import Data.Text (Text) import Data.Time (LocalTime)@@ -71,7 +72,7 @@   )  type Sql92ReasonableMarshaller be =-   ( FromBackendRow be Int, FromBackendRow be SqlNull+   ( FromBackendRow be SqlNull    , FromBackendRow be Text, FromBackendRow be Bool    , FromBackendRow be Char    , FromBackendRow be Int16, FromBackendRow be Int32, FromBackendRow be Int64@@ -89,10 +90,10 @@       , IsSql92UpdateSyntax (Sql92UpdateSyntax cmd)       , IsSql92DeleteSyntax (Sql92DeleteSyntax cmd) ) =>   IsSql92Syntax cmd where-  type Sql92SelectSyntax cmd :: *-  type Sql92InsertSyntax cmd :: *-  type Sql92UpdateSyntax cmd :: *-  type Sql92DeleteSyntax cmd :: *+  type Sql92SelectSyntax cmd :: Type+  type Sql92InsertSyntax cmd :: Type+  type Sql92UpdateSyntax cmd :: Type+  type Sql92DeleteSyntax cmd :: Type    selectCmd :: Sql92SelectSyntax cmd -> cmd   insertCmd :: Sql92InsertSyntax cmd -> cmd@@ -102,8 +103,8 @@ class ( IsSql92SelectTableSyntax (Sql92SelectSelectTableSyntax select)       , IsSql92OrderingSyntax (Sql92SelectOrderingSyntax select) ) =>     IsSql92SelectSyntax select where-    type Sql92SelectSelectTableSyntax select :: *-    type Sql92SelectOrderingSyntax select :: *+    type Sql92SelectSelectTableSyntax select :: Type+    type Sql92SelectOrderingSyntax select :: Type      selectStmt :: Sql92SelectSelectTableSyntax select                -> [Sql92SelectOrderingSyntax select]@@ -124,12 +125,12 @@        , Eq (Sql92SelectTableExpressionSyntax select) ) =>     IsSql92SelectTableSyntax select where-  type Sql92SelectTableSelectSyntax select :: *-  type Sql92SelectTableExpressionSyntax select :: *-  type Sql92SelectTableProjectionSyntax select :: *-  type Sql92SelectTableFromSyntax select :: *-  type Sql92SelectTableGroupingSyntax select :: *-  type Sql92SelectTableSetQuantifierSyntax select :: *+  type Sql92SelectTableSelectSyntax select :: Type+  type Sql92SelectTableExpressionSyntax select :: Type+  type Sql92SelectTableProjectionSyntax select :: Type+  type Sql92SelectTableFromSyntax select :: Type+  type Sql92SelectTableGroupingSyntax select :: Type+  type Sql92SelectTableSetQuantifierSyntax select :: Type    selectTableStmt :: Maybe (Sql92SelectTableSetQuantifierSyntax select)                   -> Sql92SelectTableProjectionSyntax select@@ -146,8 +147,8 @@       , IsSql92TableNameSyntax (Sql92InsertTableNameSyntax insert) ) =>   IsSql92InsertSyntax insert where -  type Sql92InsertValuesSyntax insert :: *-  type Sql92InsertTableNameSyntax insert :: *+  type Sql92InsertValuesSyntax insert :: Type+  type Sql92InsertTableNameSyntax insert :: Type    insertStmt :: Sql92InsertTableNameSyntax insert              -> [ Text ]@@ -157,8 +158,8 @@  class IsSql92ExpressionSyntax (Sql92InsertValuesExpressionSyntax insertValues) =>   IsSql92InsertValuesSyntax insertValues where-  type Sql92InsertValuesExpressionSyntax insertValues :: *-  type Sql92InsertValuesSelectSyntax insertValues :: *+  type Sql92InsertValuesExpressionSyntax insertValues :: Type+  type Sql92InsertValuesSelectSyntax insertValues :: Type    insertSqlExpressions :: [ [ Sql92InsertValuesExpressionSyntax insertValues ] ]                        -> insertValues@@ -170,9 +171,9 @@       , IsSql92TableNameSyntax (Sql92UpdateTableNameSyntax update) ) =>       IsSql92UpdateSyntax update where -  type Sql92UpdateTableNameSyntax update :: *-  type Sql92UpdateFieldNameSyntax update :: *-  type Sql92UpdateExpressionSyntax update :: *+  type Sql92UpdateTableNameSyntax  update :: Type+  type Sql92UpdateFieldNameSyntax  update :: Type+  type Sql92UpdateExpressionSyntax update :: Type    updateStmt :: Sql92UpdateTableNameSyntax update              -> [(Sql92UpdateFieldNameSyntax update, Sql92UpdateExpressionSyntax update)]@@ -182,8 +183,8 @@ class ( IsSql92TableNameSyntax (Sql92DeleteTableNameSyntax delete)       , IsSql92ExpressionSyntax (Sql92DeleteExpressionSyntax delete) ) =>   IsSql92DeleteSyntax delete where-  type Sql92DeleteTableNameSyntax delete :: *-  type Sql92DeleteExpressionSyntax delete :: *+  type Sql92DeleteTableNameSyntax  delete :: Type+  type Sql92DeleteExpressionSyntax delete :: Type    deleteStmt :: Sql92DeleteTableNameSyntax delete -> Maybe Text              -> Maybe (Sql92DeleteExpressionSyntax delete)@@ -229,7 +230,7 @@   timestampType :: Maybe Word -> Bool {-^ With time zone -} -> dataType   -- TODO interval type -class ( HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Int+class ( HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Int32       , HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Bool       , IsSql92FieldNameSyntax (Sql92ExpressionFieldNameSyntax expr)       , IsSql92QuantifierSyntax (Sql92ExpressionQuantifierSyntax expr)@@ -237,12 +238,12 @@       , IsSql92ExtractFieldSyntax (Sql92ExpressionExtractFieldSyntax expr)       , Typeable expr ) =>     IsSql92ExpressionSyntax expr where-  type Sql92ExpressionQuantifierSyntax expr :: *-  type Sql92ExpressionValueSyntax expr :: *-  type Sql92ExpressionSelectSyntax expr :: *-  type Sql92ExpressionFieldNameSyntax expr :: *-  type Sql92ExpressionCastTargetSyntax expr :: *-  type Sql92ExpressionExtractFieldSyntax expr :: *+  type Sql92ExpressionQuantifierSyntax expr :: Type+  type Sql92ExpressionValueSyntax      expr :: Type+  type Sql92ExpressionSelectSyntax     expr :: Type+  type Sql92ExpressionFieldNameSyntax  expr :: Type+  type Sql92ExpressionCastTargetSyntax expr :: Type+  type Sql92ExpressionExtractFieldSyntax expr :: Type    valueE :: Sql92ExpressionValueSyntax expr -> expr @@ -321,7 +322,7 @@ class IsSql92AggregationSetQuantifierSyntax (Sql92AggregationSetQuantifierSyntax expr) =>   IsSql92AggregationExpressionSyntax expr where -  type Sql92AggregationSetQuantifierSyntax expr :: *+  type Sql92AggregationSetQuantifierSyntax expr :: Type    countAllE :: expr   countE, avgE, maxE, minE, sumE@@ -331,13 +332,13 @@   setQuantifierDistinct, setQuantifierAll :: q  class IsSql92ExpressionSyntax (Sql92ProjectionExpressionSyntax proj) => IsSql92ProjectionSyntax proj where-  type Sql92ProjectionExpressionSyntax proj :: *+  type Sql92ProjectionExpressionSyntax proj :: Type    projExprs :: [ (Sql92ProjectionExpressionSyntax proj, Maybe Text) ]             -> proj  class IsSql92OrderingSyntax ord where-  type Sql92OrderingExpressionSyntax ord :: *+  type Sql92OrderingExpressionSyntax ord :: Type   ascOrdering, descOrdering     :: Sql92OrderingExpressionSyntax ord -> ord @@ -349,9 +350,9 @@ class IsSql92TableNameSyntax (Sql92TableSourceTableNameSyntax tblSource) =>   IsSql92TableSourceSyntax tblSource where -  type Sql92TableSourceSelectSyntax tblSource :: *-  type Sql92TableSourceExpressionSyntax tblSource :: *-  type Sql92TableSourceTableNameSyntax tblSource :: *+  type Sql92TableSourceSelectSyntax tblSource :: Type+  type Sql92TableSourceExpressionSyntax tblSource :: Type+  type Sql92TableSourceTableNameSyntax tblSource :: Type    tableNamed :: Sql92TableSourceTableNameSyntax tblSource              -> tblSource@@ -359,15 +360,15 @@   tableFromValues :: [ [ Sql92TableSourceExpressionSyntax tblSource ] ] -> tblSource  class IsSql92GroupingSyntax grouping where-  type Sql92GroupingExpressionSyntax grouping :: *+  type Sql92GroupingExpressionSyntax grouping :: Type    groupByExpressions :: [ Sql92GroupingExpressionSyntax grouping ] -> grouping  class ( IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax from)       , IsSql92ExpressionSyntax (Sql92FromExpressionSyntax from) ) =>     IsSql92FromSyntax from where-  type Sql92FromTableSourceSyntax from :: *-  type Sql92FromExpressionSyntax from :: *+  type Sql92FromTableSourceSyntax from :: Type+  type Sql92FromExpressionSyntax from :: Type    fromTable :: Sql92FromTableSourceSyntax from             -> Maybe (Text, Maybe [Text])

@@ -15,6 +15,7 @@  import Database.Beam.Backend.SQL.SQL92 +import Data.Kind ( Type ) import Data.Text ( Text )  class IsSql92SelectSyntax select =>@@ -53,7 +54,7 @@  class IsSql92SelectSyntax syntax =>   IsSql99CommonTableExpressionSelectSyntax syntax where-  type Sql99SelectCTESyntax syntax :: *+  type Sql99SelectCTESyntax syntax :: Type    withSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax @@ -63,6 +64,6 @@   withRecursiveSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax  class IsSql99CommonTableExpressionSyntax syntax where-  type Sql99CTESelectSyntax syntax :: *+  type Sql99CTESelectSyntax syntax :: Type    cteSubquerySyntax :: Text -> [Text] -> Sql99CTESelectSyntax syntax -> syntax

@@ -7,12 +7,12 @@    ) where -import           GHC.Types+import GHC.Types  -- | Class for all Beam backends class BeamBackend be where   -- | Requirements to marshal a certain type from a database of a particular backend-  type BackendFromField be :: * -> Constraint+  type BackendFromField be :: Type -> Constraint  -- | newtype mainly used to inspect the tag structure of a particular --   'Beamable'. Prevents overlapping instances in some case. Usually not used@@ -27,4 +27,4 @@ -- >                 deriving (Generic, Typeable) -- -- See 'Columnar' for more information.-data Nullable (c :: * -> *) x+data Nullable (c :: Type -> Type) x

@@ -6,9 +6,6 @@ import           Control.Exception  import qualified Data.Map as M-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif  import           Network.URI @@ -30,12 +27,12 @@   BeamURIOpeners :: M.Map String (BeamURIOpener c) -> BeamURIOpeners c  instance Semigroup (BeamURIOpeners c) where-  (<>) = mappend+  BeamURIOpeners a <> BeamURIOpeners b =+    BeamURIOpeners (a <> b)  instance Monoid (BeamURIOpeners c) where   mempty = BeamURIOpeners mempty-  mappend (BeamURIOpeners a) (BeamURIOpeners b) =-    BeamURIOpeners (mappend a b)+  mappend = (<>)  data OpenedBeamConnection c where   OpenedBeamConnection

@@ -19,6 +19,7 @@      , QBaseScope +     , module Database.Beam.Query.Combinators     , module Database.Beam.Query.Extensions @@ -32,7 +33,6 @@     , module Database.Beam.Query.Operator      -- ** ANSI SQL Booleans-    , Beam.SqlBool     , isTrue_, isNotTrue_     , isFalse_, isNotFalse_     , isUnknown_, isNotUnknown_@@ -42,14 +42,15 @@      -- ** Unquantified comparison operators     , HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)-    , SqlEq(..), SqlOrd(..)+    , HasTableEquality+    , SqlEq(..), SqlOrd(..), SqlIn(..)+    , HasSqlInTable(..)      -- ** Quantified Comparison Operators #quantified-comparison-operator#     , SqlEqQuantified(..), SqlOrdQuantified(..)     , QQuantified     , anyOf_, allOf_, anyIn_, allIn_     , between_-    , in_      , module Database.Beam.Query.Aggregate @@ -79,10 +80,13 @@     -- ** @UPDATE@     , SqlUpdate(..)     , update, save-    , updateTable, set, setFieldsTo+    , update', save'+    , updateTable, updateTable'+    , set, setFieldsTo     , toNewValue, toOldValue, toUpdatedValue     , toUpdatedValueMaybe     , updateRow, updateTableRow+    , updateRow', updateTableRow'     , runUpdate      -- ** @DELETE@@@ -101,8 +105,7 @@ import Database.Beam.Query.Extensions import Database.Beam.Query.Extract import Database.Beam.Query.Internal-import Database.Beam.Query.Operator hiding (SqlBool)-import qualified Database.Beam.Query.Operator as Beam+import Database.Beam.Query.Operator import Database.Beam.Query.Ord import Database.Beam.Query.Relationships import Database.Beam.Query.Types (QGenExpr) -- hide QGenExpr constructor@@ -116,6 +119,7 @@ import Control.Monad.Writer import Control.Monad.State.Strict +import Data.Kind (Type) import Data.Functor.Const (Const(..)) import Data.Text (Text) import Data.Proxy@@ -202,7 +206,7 @@ -- * INSERT  -- | Represents a SQL @INSERT@ command that has not yet been run-data SqlInsert be (table :: (* -> *) -> *)+data SqlInsert be (table :: (Type -> Type) -> Type)   = SqlInsert !(TableSettings table) !(BeamSqlBackendInsertSyntax be)   | SqlInsertNoRows @@ -241,7 +245,7 @@  -- | Represents a source of values that can be inserted into a table shaped like --   'tbl'.-data SqlInsertValues be proj --(tbl :: (* -> *) -> *)+data SqlInsertValues be proj     = SqlInsertValues (BeamSqlBackendInsertValuesSyntax be)     | SqlInsertValuesEmpty @@ -287,13 +291,43 @@ -- * UPDATE  -- | Represents a SQL @UPDATE@ statement for the given @table@.-data SqlUpdate be (table :: (* -> *) -> *)+data SqlUpdate be (table :: (Type -> Type) -> Type)   = SqlUpdate !(TableSettings table) !(BeamSqlBackendUpdateSyntax be)   | SqlIdentityUpdate -- An update with no assignments  -- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to --   build a @WHERE@ clause. --+--   An internal implementation for 'update' and 'update'' functions.+--   Allows to choose boolean type in the @WHERE@ clause.+updateImpl :: forall bool table db be+            . ( BeamSqlBackend be, Beamable table )+           => DatabaseEntity be db (TableEntity table)+              -- ^ The table to insert into+           -> (forall s. table (QField s) -> QAssignment be s)+              -- ^ A sequence of assignments to make.+           -> (forall s. table (QExpr be s) -> QExpr be s bool)+              -- ^ Build a @WHERE@ clause given a table containing expressions+           -> SqlUpdate be table+updateImpl (DatabaseEntity dt@(DatabaseTable {})) mkAssignments mkWhere =+  case assignments of+    [] -> SqlIdentityUpdate+    _  -> SqlUpdate (dbTableSettings dt)+                    (updateStmt (tableNameFromEntity dt)+                       assignments (Just (where_ "t")))+  where+    QAssignment assignments = mkAssignments tblFields+    QExpr where_ = mkWhere tblFieldExprs++    tblFields = changeBeamRep (\(Columnar' fd) -> Columnar' (QField False (dbTableCurrentName dt) (fd ^. fieldName)))+                              (dbTableSettings dt)+    tblFieldExprs = changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar' (QExpr (pure (fieldE (unqualifiedField nm))))) tblFields++-- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to+--   build a @WHERE@ clause.+--+--   Use 'update'' for comparisons with 'SqlBool'.+-- --   See the '(<-.)' operator for ways to build assignments. The argument to the --   second argument is a the table parameterized over 'QField', which --   represents the left hand side of assignments. Sometimes, you'd like to also@@ -307,21 +341,31 @@        -> (forall s. table (QExpr be s) -> QExpr be s Bool)           -- ^ Build a @WHERE@ clause given a table containing expressions        -> SqlUpdate be table-update (DatabaseEntity dt@(DatabaseTable {})) mkAssignments mkWhere =-  case assignments of-    [] -> SqlIdentityUpdate-    _  -> SqlUpdate (dbTableSettings dt)-                    (updateStmt (tableNameFromEntity dt)-                       assignments (Just (where_ "t")))-  where-    QAssignment assignments = mkAssignments tblFields-    QExpr where_ = mkWhere tblFieldExprs+update = updateImpl @Bool -    tblFields = changeBeamRep (\(Columnar' fd) -> Columnar' (QField False (dbTableCurrentName dt) (fd ^. fieldName)))-                              (dbTableSettings dt)-    tblFieldExprs = changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar' (QExpr (pure (fieldE (unqualifiedField nm))))) tblFields+-- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to+--   build a @WHERE@ clause.+--+--   Uses a 'SqlBool' comparison. Use 'update' for comparisons with 'Bool'.+--+--   See the '(<-.)' operator for ways to build assignments. The argument to the+--   second argument is a the table parameterized over 'QField', which+--   represents the left hand side of assignments. Sometimes, you'd like to also+--   get the current value of a particular column. You can use the 'current_'+--   function to convert a 'QField' to a 'QExpr'.+update' :: ( BeamSqlBackend be, Beamable table )+        => DatabaseEntity be db (TableEntity table)+           -- ^ The table to insert into+        -> (forall s. table (QField s) -> QAssignment be s)+           -- ^ A sequence of assignments to make.+        -> (forall s. table (QExpr be s) -> QExpr be s SqlBool)+           -- ^ Build a @WHERE@ clause given a table containing expressions+        -> SqlUpdate be table+update' = updateImpl @SqlBool --- | A specialization of 'update' that matches the given (already existing) row+-- | A specialization of 'update' that matches the given (already existing) row.+--+--   Use 'updateRow'' for an internal 'SqlBool' comparison. updateRow :: ( BeamSqlBackend be, Table table              , HasTableEquality be (PrimaryKey table)              , SqlValableTable be (PrimaryKey table) )@@ -332,19 +376,38 @@           -> (forall s. table (QField s) -> QAssignment be s)              -- ^ A sequence of assignments to make.           -> SqlUpdate be table-updateRow tbl row update' =-  update tbl update' (references_ (val_ (pk row)))+updateRow tbl row assignments =+  update tbl assignments (references_ (val_ (pk row))) +-- | A specialization of 'update'' that matches the given (already existing) row.+--+--   Use 'updateRow' for an internal 'Bool' comparison.+updateRow' :: ( BeamSqlBackend be, Table table+              , HasTableEquality be (PrimaryKey table)+              , SqlValableTable be (PrimaryKey table) )+           => DatabaseEntity be db (TableEntity table)+              -- ^ The table to insert into+           -> table Identity+              -- ^ The row to update+           -> (forall s. table (QField s) -> QAssignment be s)+              -- ^ A sequence of assignments to make.+           -> SqlUpdate be table+updateRow' tbl row assignments =+  update' tbl assignments (references_' (val_ (pk row)))+ -- | A specialization of 'update' that is more convenient for normal tables.-updateTable :: forall table db be-             . ( BeamSqlBackend be, Beamable table )-            => DatabaseEntity be db (TableEntity table)-               -- ^ The table to update-            -> table (QFieldAssignment be table)-               -- ^ Updates to be made (use 'set' to construct an empty field)-            -> (forall s. table (QExpr be s) -> QExpr be s Bool)-            -> SqlUpdate be table-updateTable tblEntity assignments mkWhere =+--+--   An internal implementation of 'updateTable' and 'updateTable'' functions.+--   Allows choosing between 'Bool' and 'SqlBool'.+updateTableImpl :: forall bool table db be+                 . ( BeamSqlBackend be, Beamable table )+                => DatabaseEntity be db (TableEntity table)+                   -- ^ The table to update+                -> table (QFieldAssignment be table)+                   -- ^ Updates to be made (use 'set' to construct an empty field)+                -> (forall s. table (QExpr be s) -> QExpr be s bool)+                -> SqlUpdate be table+updateTableImpl tblEntity assignments mkWhere =   let mkAssignments :: forall s. table (QField s) -> QAssignment be s       mkAssignments tblFields =         let tblExprs = changeBeamRep (\(Columnar' fd) -> Columnar' (current_ fd)) tblFields@@ -359,10 +422,38 @@                     pure c)              tblFields assignments -  in update tblEntity mkAssignments mkWhere+  in updateImpl tblEntity mkAssignments mkWhere +-- | A specialization of 'update' that is more convenient for normal tables.+--+--   Use 'updateTable'' for comparisons with 'SqlBool'.+updateTable :: forall table db be+             . ( BeamSqlBackend be, Beamable table )+            => DatabaseEntity be db (TableEntity table)+               -- ^ The table to update+            -> table (QFieldAssignment be table)+               -- ^ Updates to be made (use 'set' to construct an empty field)+            -> (forall s. table (QExpr be s) -> QExpr be s Bool)+            -> SqlUpdate be table+updateTable = updateTableImpl @Bool++-- | A specialization of 'update'' that is more convenient for normal tables.+--+--   Use 'updateTable' for comparisons with 'Bool'.+updateTable' :: forall table db be+              . ( BeamSqlBackend be, Beamable table )+             => DatabaseEntity be db (TableEntity table)+                -- ^ The table to update+             -> table (QFieldAssignment be table)+                -- ^ Updates to be made (use 'set' to construct an empty field)+             -> (forall s. table (QExpr be s) -> QExpr be s SqlBool)+             -> SqlUpdate be table+updateTable' = updateTableImpl @SqlBool+ -- | Convenience form of 'updateTable' that generates a @WHERE@ clause--- that matches only the already existing entity+-- that matches only the already existing entity.+--+-- Use 'updateTableRow'' for an internal 'SqlBool' comparison. updateTableRow :: ( BeamSqlBackend be, Table table                   , HasTableEquality be (PrimaryKey table)                   , SqlValableTable be (PrimaryKey table) )@@ -373,9 +464,27 @@                -> table (QFieldAssignment be table)                   -- ^ Updates to be made (use 'set' to construct an empty field)                -> SqlUpdate be table-updateTableRow tbl row update' =-  updateTable tbl update' (references_ (val_ (pk row)))+updateTableRow tbl row assignments =+  updateTable tbl assignments (references_ (val_ (pk row))) +-- | Convenience form of 'updateTable'' that generates a @WHERE@ clause+-- that matches only the already existing entity.+--+-- Uses 'update'' with a 'SqlBool' comparison.+-- Use 'updateTableRow' for an internal 'Bool' comparison.+updateTableRow' :: ( BeamSqlBackend be, Table table+                   , HasTableEquality be (PrimaryKey table)+                   , SqlValableTable be (PrimaryKey table) )+                => DatabaseEntity be db (TableEntity table)+                   -- ^ The table to update+                -> table Identity+                   -- ^ The row to update+                -> table (QFieldAssignment be table)+                   -- ^ Updates to be made (use 'set' to construct an empty field)+                -> SqlUpdate be table+updateTableRow' tbl row assignments =+  updateTable' tbl assignments (references_' (val_ (pk row)))+ set :: forall table be table'. Beamable table => table (QFieldAssignment be table') set = changeBeamRep (\_ -> Columnar' (QFieldAssignment (\_ -> Nothing))) (tblSkeleton :: TableSkeleton table) @@ -429,6 +538,8 @@ --   the row where each primary key field is exactly what is given. -- --   Note: This is a pure SQL @UPDATE@ command. This does not upsert or merge values.+--+--   Use 'save'' for an internal 'SqlBool' comparison. save :: forall table be db.         ( Table table         , BeamSqlBackend be@@ -447,6 +558,33 @@   updateTableRow tbl v     (setFieldsTo (val_ v)) +-- | Generate a 'SqlUpdate' that will update the given table row with the given value.+-- This is a variant using 'update'' and a 'SqlBool' comparison.+--+--   The SQL @UPDATE@ that is generated will set every non-primary key field for+--   the row where each primary key field is exactly what is given.+--+--   Note: This is a pure SQL @UPDATE@ command. This does not upsert or merge values.+--+--   Use 'save' for an internal 'Bool' comparison.+save' :: forall table be db.+         ( Table table+         , BeamSqlBackend be++         , SqlValableTable be (PrimaryKey table)+         , SqlValableTable be table++         , HasTableEquality be (PrimaryKey table)+         )+      => DatabaseEntity be db (TableEntity table)+         -- ^ Table to update+      -> table Identity+         -- ^ Value to set to+      -> SqlUpdate be table+save' tbl v =+  updateTableRow' tbl v+    (setFieldsTo (val_ v))+ -- | Run a 'SqlUpdate' in a 'MonadBeam'. runUpdate :: (BeamSqlBackend be, MonadBeam be m)           => SqlUpdate be tbl -> m ()@@ -456,7 +594,7 @@ -- * DELETE  -- | Represents a SQL @DELETE@ statement for the given @table@-data SqlDelete be (table :: (* -> *) -> *)+data SqlDelete be (table :: (Type -> Type) -> Type)   = SqlDelete !(TableSettings table) !(BeamSqlBackendDeleteSyntax be)  -- | Build a 'SqlDelete' from a table and a way to build a @WHERE@ clause

@@ -0,0 +1,94 @@+-- | This module contains support for defining "ad-hoc" queries. That+-- is queries on tables that do not necessarily have corresponding+-- 'Beamable' table types.+module Database.Beam.Query.Adhoc+  ( Adhoc(..)++  , NamedField+  , table_, field_+  ) where++import           Database.Beam.Query.Internal+import           Database.Beam.Backend.SQL++import           Control.Monad.Free.Church++import           Data.Kind (Type)+import qualified Data.Text as T++class Adhoc structure where+  type AdhocTable structure (f :: Type -> Type) :: Type++  mkAdhocField :: (forall a. T.Text -> f a) -> structure -> AdhocTable structure f++newtype NamedField a = NamedField T.Text++instance Adhoc (NamedField a) where+  type AdhocTable (NamedField a) f = f a++  mkAdhocField mk (NamedField nm) = mk nm++instance (Adhoc a, Adhoc b) => Adhoc (a, b) where+  type AdhocTable (a, b) y = (AdhocTable a y, AdhocTable b y)+  mkAdhocField mk (a, b) = (mkAdhocField mk a, mkAdhocField mk b)++instance (Adhoc a, Adhoc b, Adhoc c) => Adhoc (a, b, c) where+  type AdhocTable (a, b, c) y = (AdhocTable a y, AdhocTable b y, AdhocTable c y)+  mkAdhocField mk (a, b, c) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c)++instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d) => Adhoc (a, b, c, d) where+  type AdhocTable (a, b, c, d) y = (AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y)+  mkAdhocField mk (a, b, c, d) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c, mkAdhocField mk d)++instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e) => Adhoc (a, b, c, d, e) where+  type AdhocTable (a, b, c, d, e) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y+                                      , AdhocTable e y )+  mkAdhocField mk (a, b, c, d, e) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c, mkAdhocField mk d, mkAdhocField mk e)++instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f) => Adhoc (a, b, c, d, e, f) where+  type AdhocTable (a, b, c, d, e, f) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y+                                         , AdhocTable e y, AdhocTable f y )+  mkAdhocField mk (a, b, c, d, e, f) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c, mkAdhocField mk d, mkAdhocField mk e, mkAdhocField mk f)++instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f, Adhoc g) => Adhoc (a, b, c, d, e, f, g) where+  type AdhocTable (a, b, c, d, e, f, g) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y+                                            , AdhocTable e y, AdhocTable f y, AdhocTable g y )+  mkAdhocField mk (a, b, c, d, e, f, g) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c, mkAdhocField mk d, mkAdhocField mk e, mkAdhocField mk f, mkAdhocField mk g)++instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f, Adhoc g, Adhoc h) =>+  Adhoc (a, b, c, d, e, f, g, h) where+  type AdhocTable (a, b, c, d, e, f, g, h) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y+                                               , AdhocTable e y, AdhocTable f y, AdhocTable g y, AdhocTable h y )+  mkAdhocField mk (a, b, c, d, e, f, g, h) = (mkAdhocField mk a, mkAdhocField mk b, mkAdhocField mk c, mkAdhocField mk d, mkAdhocField mk e, mkAdhocField mk f, mkAdhocField mk g, mkAdhocField mk h)++-- | Introduce a table into a query without using the 'Beamable' and 'Database' machinery.+--+-- The first argument is the optional name of the schema the table is in and the second is the name+-- of the table to source from.+--+-- The third argument is a tuple (or any nesting of tuples) where each value is of type 'NamedField'+-- (use 'field_' to construct).+--+-- The return value is a tuple (or any nesting of tuples) of the same shape as @structure@ but where+-- each value is a 'QExpr'.+--+-- For example, to source from the table @Table1@, with fields @Field1@ (A boolean), @Field2@ (a+-- timestamp), and @Field3@ (a string)+--+-- > table_ Nothing "Table1" ( field_ @Bool "Field1", field_ @UTCTime "Field2", field_ @Text "Field3" )+--+table_ :: forall be db structure s+        . (Adhoc structure, BeamSqlBackend be, Projectible be (AdhocTable structure (QExpr be s)))+       => Maybe T.Text -> T.Text -> structure -> Q be db s (AdhocTable structure (QExpr be s))+table_ schemaNm tblNm tbl =+  Q $ liftF (QAll (\_ -> fromTable (tableNamed (tableName schemaNm tblNm)) . Just . (, Nothing))+                  (\tblNm' -> let mk :: forall a. T.Text -> QExpr be s a+                                  mk nm = QExpr (\_ -> fieldE (qualifiedField tblNm' nm))+                              in mkAdhocField mk tbl)+                  (\_ -> Nothing) snd)++-- | Used to construct 'NamedField's, most often with an explicitly applied type.+--+-- The type can be omitted if the value is used unambiguously elsewhere.+field_ :: forall a. T.Text -> NamedField a+field_ = NamedField

@@ -1,7 +1,7 @@ module Database.Beam.Query.Aggregate   ( -- * Aggregates     -- | See the corresponding-    --   <https://tathougies.github.io/beam/user-guide/queries/aggregates.md manual section>+    --   <https://haskell-beam.github.io/beam/user-guide/queries/aggregates.md manual section>     --   for more detail      aggregate_@@ -61,7 +61,7 @@ --   'QExpr's). -- --   For usage examples, see---   <https://tathougies.github.io/beam/user-guide/queries/aggregates/ the manual>.+--   <https://haskell-beam.github.io/beam/user-guide/queries/aggregates/ the manual>. aggregate_ :: forall be a r db s.               ( BeamSqlBackend be               , Aggregable be a, Projectible be r, Projectible be a@@ -174,7 +174,7 @@ sum_ = sumOver_ allInGroup_  -- | SQL @COUNT(*)@ function-countAll_ :: BeamSqlBackend be => QAgg be s Int+countAll_ :: ( BeamSqlBackend be, Integral a ) => QAgg be s a countAll_ = QExpr (pure countAllE)  -- | SQL @COUNT(ALL ..)@ function (but without the explicit ALL)@@ -193,18 +193,18 @@ percentRank_ = QExpr (pure percentRankAggE)  -- | SQL2003 @DENSE_RANK@ function (Requires T612 Advanced OLAP operations support)-denseRank_ :: BeamSqlT612Backend be-           => QAgg be s Int+denseRank_ :: ( BeamSqlT612Backend be, Integral a )+           => QAgg be s a denseRank_ = QExpr (pure denseRankAggE)  -- | SQL2003 @ROW_NUMBER@ function-rowNumber_ :: BeamSql2003ExpressionBackend be-           =>  QAgg be s Int+rowNumber_ :: ( BeamSql2003ExpressionBackend be, Integral a )+           =>  QAgg be s a rowNumber_ = QExpr (pure rowNumberE)  -- | SQL2003 @RANK@ function (Requires T611 Elementary OLAP operations support)-rank_ :: BeamSqlT611Backend be-      => QAgg be s Int+rank_ :: ( BeamSqlT611Backend be, Integral a )+      => QAgg be s a rank_ = QExpr (pure rankAggE)  minOver_, maxOver_

@@ -12,15 +12,10 @@ import Control.Monad.Writer hiding ((<>)) import Control.Monad.State.Strict -import Data.Text (Text)-import Data.String+import Data.Kind (Type) import Data.Proxy (Proxy(Proxy))-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif---import Unsafe.Coerce+import Data.String+import Data.Text (Text)  data Recursiveness be where     Nonrecursive :: Recursiveness be@@ -29,14 +24,27 @@  instance Monoid (Recursiveness be) where     mempty = Nonrecursive-    mappend Recursive _ = Recursive-    mappend _ Recursive = Recursive-    mappend _ _ = Nonrecursive+    mappend = (<>)  instance Semigroup (Recursiveness be) where-  (<>) = mappend+    Recursive <> _ = Recursive+    _ <> Recursive = Recursive+    _ <> _ = Nonrecursive -newtype With be (db :: (* -> *) -> *) a+-- | Monad in which @SELECT@ statements can be made (via 'selecting')+-- and bound to result names for re-use later. This has the advantage+-- of only computing each result once. In SQL, this is translated to a+-- common table expression.+--+-- Once introduced, results can be re-used in future queries with 'reuse'.+--+-- 'With' is also a member of 'MonadFix' for backends that support+-- recursive CTEs. In this case, you can use @mdo@ or @rec@ notation+-- (with @RecursiveDo@ enabled) to bind result values (again, using+-- 'reuse') even /before/ they're introduced.+--+-- See further documentation <https://haskell-beam.github.io/beam/user-guide/queries/common-table-expressions/ here>.+newtype With be (db :: (Type -> Type) -> Type) a     = With { runWith :: WriterT (Recursiveness be, [ BeamSql99BackendCTESyntax be ])                                 (State Int) a }     deriving (Monad, Applicative, Functor)@@ -47,6 +55,9 @@  data QAnyScope +-- | Query results that have been introduced into a common table+-- expression via 'selecting' that can be used in future queries with+-- 'reuse'. data ReusableQ be db res where     ReusableQ :: Proxy res -> (forall s. Proxy s -> Q be db s (WithRewrittenThread QAnyScope s res)) -> ReusableQ be db res @@ -63,6 +74,9 @@                                  (\_ -> Nothing)                                  (rewriteThread @QAnyScope @res proxyS . snd))) +-- | Introduce the result of a query as a result in a common table+-- expression. The returned value can be used in future queries by+-- applying 'reuse'. selecting :: forall res be db            . ( BeamSql99CommonTableExpressionBackend be, HasQBuilder be              , Projectible be res@@ -80,9 +94,7 @@      pure (reusableForCTE tblNm) -rescopeQ :: QM be db s res -> QM be db s' res-rescopeQ = unsafeCoerce-+-- | Introduces the result of a previous 'selecting' (a CTE) into a new query reuse :: forall s be db res        . ReusableQ be db res -> Q be db s (WithRewrittenThread QAnyScope s res) reuse (ReusableQ _ q) = q (Proxy @s)

@@ -13,6 +13,7 @@     -- ** @IF-THEN-ELSE@ support     , if_, then_, else_     , then_'+    , ifThenElse_, bool_      -- * SQL @UPDATE@ assignments     , (<-.), current_@@ -30,7 +31,7 @@     , related_, relatedBy_, relatedBy_'     , leftJoin_, leftJoin_'     , perhaps_, outerJoin_, outerJoin_'-    , subselect_, references_+    , subselect_, references_, references_'      , nub_ @@ -49,14 +50,14 @@      -- ** Set operations     -- |  'Q' values can be combined using a variety of set operations. See the-    --    <https://tathougies.github.io/beam/user-guide/queries/combining-queries manual section>.+    --    <https://haskell-beam.github.io/beam/user-guide/queries/combining-queries manual section>.     , union_, unionAll_     , intersect_, intersectAll_     , except_, exceptAll_      -- * Window functions     -- | See the corresponding-    --   <https://tathougies.github.io/beam/user-guide/queries/window-functions manual section> for more.+    --   <https://haskell-beam.github.io/beam/user-guide/queries/window-functions manual section> for more.     , over_, frame_, bounds_, unbounded_, nrows_, fromBound_     , noBounds_, noOrder_, noPartition_     , partitionBy_, orderPartitionBy_, withWindow_@@ -79,17 +80,10 @@ import Control.Monad.Free import Control.Applicative -#if !MIN_VERSION_base(4, 11, 0)-import Control.Monad.Writer hiding ((<>))-import Data.Semigroup-#endif- import Data.Maybe import Data.Proxy import Data.Time (LocalTime) -import GHC.Generics- -- | Introduce all entries of a table into the 'Q' monad all_ :: ( Database be db, BeamSqlBackend be )        => DatabaseEntity be db (TableEntity table)@@ -109,6 +103,8 @@                     (tableFieldsToExpressions (dbViewSettings vw))                     (\_ -> Nothing) snd) +-- | SQL @VALUES@ clause. Introduce the elements of the given list as+-- rows in a joined table. values_ :: forall be db s a          . ( Projectible be a            , BeamSqlBackend be )@@ -267,14 +263,14 @@         => QExpr be s SqlBool -> Q be db s () guard_' (QExpr guardE') = Q (liftF (QGuard guardE' ())) --- | Synonym for @clause >>= \x -> guard_ (mkExpr x)>> pure x@. Use 'filter_'' for comparisons with 'SqlBool'+-- | Synonym for @clause >>= \\x -> guard_ (mkExpr x)>> pure x@. Use 'filter_'' for comparisons with 'SqlBool' filter_ :: forall r be db s          . BeamSqlBackend be         => (r -> QExpr be s Bool)         -> Q be db s r -> Q be 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'+-- | Synonym for @clause >>= \\x -> guard_' (mkExpr x)>> pure x@. Use 'filter_' for comparisons with 'Bool' filter_' :: forall r be db s           . BeamSqlBackend be         => (r -> QExpr be s SqlBool)@@ -310,11 +306,20 @@  -- | Generate an appropriate boolean 'QGenExpr' comparing the given foreign key --   to the given table. Useful for creating join conditions.+--   Use 'references_'' for a 'SqlBool' comparison. references_ :: ( Table t, BeamSqlBackend be                , HasTableEquality be (PrimaryKey t) )             => PrimaryKey t (QGenExpr ctxt be s) -> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s Bool references_ fk tbl = fk ==. pk tbl +-- | Generate an appropriate boolean 'QGenExpr' comparing the given foreign key+--   to the given table. Useful for creating join conditions.+--   Use 'references_' for a 'Bool' comparison.+references_' :: ( Table t, BeamSqlBackend be+                , HasTableEquality be (PrimaryKey t) )+             => PrimaryKey t (QGenExpr ctxt be s) -> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s SqlBool+references_' fk tbl = fk ==?. pk tbl+ -- | Only return distinct values from a query nub_ :: ( BeamSqlBackend be, Projectible be r )      => Q be db s r -> Q be db s r@@ -359,18 +364,18 @@   QExpr (\tbl -> subqueryE (buildSqlQuery tbl q))  -- | SQL @CHAR_LENGTH@ function-charLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text )-            => QGenExpr context be s text -> QGenExpr context be s Int+charLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text, Integral a )+            => QGenExpr context be s text -> QGenExpr context be s a charLength_ (QExpr s) = QExpr (charLengthE <$> s)  -- | SQL @OCTET_LENGTH@ function-octetLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text )-             => QGenExpr context be s text -> QGenExpr context be s Int+octetLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text, Integral a )+             => QGenExpr context be s text -> QGenExpr context be s a octetLength_ (QExpr s) = QExpr (octetLengthE <$> s)  -- | SQL @BIT_LENGTH@ function-bitLength_ :: BeamSqlBackend be-           => QGenExpr context be s SqlBitString -> QGenExpr context be s Int+bitLength_ :: ( BeamSqlBackend be, Integral a )+           => QGenExpr context be s SqlBitString -> QGenExpr context be s a bitLength_ (QExpr x) = QExpr (bitLengthE <$> x)  -- | SQL @CURRENT_TIMESTAMP@ function@@ -512,7 +517,7 @@ -- --   But this is not ----- > aggregate_ (\_ -> as_ @Int countAll_) ..+-- > aggregate_ (\_ -> as_ @Int32 countAll_) .. -- as_ :: forall a ctxt be s. QGenExpr ctxt be s a -> QGenExpr ctxt be s a as_ = id@@ -543,8 +548,7 @@   SqlValable (table (QGenExpr ctxt be s)) where   val_ tbl =     let fields :: table (WithConstraint (BeamSqlBackendCanSerialize be))-        fields = to (gWithConstrainedFields (Proxy @(BeamSqlBackendCanSerialize be))-                                            (Proxy @(Rep (table Exposed))) (from tbl))+        fields = withConstrainedFields tbl     in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (BeamSqlBackendCanSerialize be) x)) ->                          Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields instance ( Beamable table, BeamSqlBackend be@@ -554,8 +558,7 @@    val_ tbl =     let fields :: table (Nullable (WithConstraint (BeamSqlBackendCanSerialize be)))-        fields = to (gWithConstrainedFields (Proxy @(BeamSqlBackendCanSerialize be))-                                            (Proxy @(Rep (table (Nullable Exposed)))) (from tbl))+        fields = withNullableConstrainedFields tbl     in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (BeamSqlBackendCanSerialize be) (Maybe x))) ->                          Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields @@ -587,10 +590,10 @@        => Int -> QFrameBound be nrows_ x = QFrameBound (nrowsBoundSyntax x) -noPartition_ :: Maybe (QExpr be s Int)+noPartition_ :: Integral a => Maybe (QExpr be s a) noPartition_ = Nothing -noOrder_ :: Maybe (QOrd be s Int)+noOrder_ :: Integral a => Maybe (QOrd be s a) noOrder_ = Nothing  partitionBy_, orderPartitionBy_ :: partition -> Maybe partition@@ -697,7 +700,7 @@ --   generated by a backend-specific ordering) or an (possibly nested) tuple of --   results of the former. -----   The <https://tathougies.github.io/beam/user-guide/queries/ordering manual section>+--   The <https://haskell-beam.github.io/beam/user-guide/queries/ordering manual section> --   has more information. orderBy_ :: forall s a ordering be db           . ( Projectible be a, SqlOrderable be ordering@@ -788,6 +791,22 @@     -> QGenExpr context be s a if_ conds (QIfElse (QExpr elseExpr)) =   QExpr (\tbl -> caseE (map (\(QIfCond (QExpr cond) (QExpr res)) -> (cond tbl, res tbl)) conds) (elseExpr tbl))++ifThenElse_+  :: BeamSqlBackend be+  => QGenExpr context be s Bool+  -> QGenExpr context be s a+  -> QGenExpr context be s a+  -> QGenExpr context be s a+ifThenElse_ c t f = if_ [c `then_` t] (else_ f)++bool_+  :: BeamSqlBackend be+  => QGenExpr context be s a+  -> QGenExpr context be s a+  -> QGenExpr context be s Bool+  -> QGenExpr context be s a+bool_ f t c = ifThenElse_ c t f  -- | SQL @COALESCE@ support coalesce_ :: BeamSqlBackend be

@@ -20,10 +20,10 @@ -- --   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'.+--   mandate that we receive two 'Int32'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_ :: QGenExpr e ctxt s Int32 -> QGenExpr e ctxt s Int32 -> QGenExpr e ctxt s T.Text -> QGenExpr e ctxt s Bool -- myFunc_ = customExpr_ myFuncImpl -- @ --@@ -31,7 +31,7 @@ --   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>+--   <https://haskell-beam.github.io/beam/user-guide/extensibility/ extensibility> --   in the user guide for example usage. module Database.Beam.Query.CustomSQL   (@@ -51,17 +51,15 @@ import           Data.ByteString (ByteString) import           Data.ByteString.Builder (byteString, toLazyByteString) import           Data.ByteString.Lazy (toStrict)-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif +import           Data.Kind (Type) import           Data.String import qualified Data.Text as T  -- | A type-class for expression syntaxes that can embed custom expressions. class (Monoid (CustomSqlSyntax syntax), Semigroup (CustomSqlSyntax syntax), IsString (CustomSqlSyntax syntax)) =>   IsCustomSqlSyntax syntax where-  data CustomSqlSyntax syntax :: *+  data CustomSqlSyntax syntax :: Type    -- | Given an arbitrary string-like expression, produce a 'syntax' that represents the   --   'ByteString' as a SQL expression.@@ -80,11 +78,12 @@  newtype CustomSqlSnippet be = CustomSqlSnippet (T.Text -> CustomSqlSyntax (BeamSqlBackendExpressionSyntax be)) instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => Semigroup (CustomSqlSnippet be) where-  (<>) = mappend+  CustomSqlSnippet a <> CustomSqlSnippet b =+    CustomSqlSnippet $ \pfx -> a pfx <> b pfx instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => Monoid (CustomSqlSnippet be) where   mempty = CustomSqlSnippet (pure mempty)-  mappend (CustomSqlSnippet a) (CustomSqlSnippet b) =-    CustomSqlSnippet $ \pfx -> a pfx <> b pfx+  mappend = (<>)+ instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => IsString (CustomSqlSnippet be) where   fromString s = CustomSqlSnippet $ \_ -> fromString s 

@@ -41,8 +41,8 @@  import Database.Beam.Backend.SQL -ntile_ :: (BeamSqlBackend be, BeamSqlT614Backend be)-       => QExpr be s Int -> QAgg be s a+ntile_ :: (BeamSqlBackend be, BeamSqlT614Backend be, Integral n)+       => QExpr be s n -> QAgg be s a ntile_ (QExpr a) = QExpr (ntileE <$> a)  lead1_, lag1_@@ -52,14 +52,14 @@ lag1_ (QExpr a) = QExpr (lagE <$> a <*> pure Nothing <*> pure Nothing)  lead_, lag_-  :: (BeamSqlBackend be, BeamSqlT615Backend be)-  => QExpr be s a -> QExpr be s Int -> QAgg be s a+  :: (BeamSqlBackend be, BeamSqlT615Backend be, Integral n)+  => QExpr be s a -> QExpr be s n -> QAgg be s a lead_ (QExpr a) (QExpr n) = QExpr (leadE <$> a <*> (Just <$> n) <*> pure Nothing) lag_ (QExpr a) (QExpr n) = QExpr (lagE <$> a <*> (Just <$> n) <*> pure Nothing)  leadWithDefault_, lagWithDefault_-  :: (BeamSqlBackend be, BeamSqlT615Backend be)-  => QExpr be s a -> QExpr be s Int -> QExpr be s a+  :: (BeamSqlBackend be, BeamSqlT615Backend be, Integral n)+  => QExpr be s a -> QExpr be s n -> QExpr be s a   -> QAgg be s a leadWithDefault_ (QExpr a) (QExpr n) (QExpr def) =   QExpr (leadE <$> a <*> fmap Just n <*> fmap Just def)@@ -75,8 +75,8 @@  -- TODO see comment for 'firstValue_' and 'lastValue_' nthValue_-  :: (BeamSqlBackend be, BeamSqlT618Backend be)-  => QExpr be s a -> QExpr be s Int -> QAgg be s a+  :: (BeamSqlBackend be, BeamSqlT618Backend be, Integral n)+  => QExpr be s a -> QExpr be s n -> QAgg be s a nthValue_ (QExpr a) (QExpr n) = QExpr (nthValueE <$> a <*> n)  ln_, exp_, sqrt_

@@ -26,14 +26,15 @@ import           GHC.TypeLits import           GHC.Types +import           Unsafe.Coerce+ type ProjectibleInBackend be a =-  ( -- Eq (Sql92SelectExpressionSyntax syntax)-    Projectible be a+  ( Projectible be a   , ProjectibleValue be a )  type TablePrefix = T.Text -data QF be (db :: (* -> *) -> *) s next where+data QF be (db :: (Type -> Type) -> Type) s next where   QDistinct :: Projectible be r             => (r -> WithExprContext (BeamSqlBackendSetQuantifierSyntax be))             -> QM be db s r -> (r -> next) -> QF be db s next@@ -110,7 +111,7 @@ -- | The type of queries over the database `db` returning results of type `a`. -- The `s` argument is a threading argument meant to restrict cross-usage of -- `QExpr`s. 'syntax' represents the SQL syntax that this query is building.-newtype Q be (db :: (* -> *) -> *) s a+newtype Q be (db :: (Type -> Type) -> Type) s a   = Q { runQ :: QM be db s a }     deriving (Monad, Applicative, Functor) @@ -125,7 +126,7 @@   deriving (Show, Eq, Ord)  newtype QAssignment be s-  = QAssignment [(BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)]+  = QAssignment { unQAssignment :: [(BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)] }   deriving (Monoid, Semigroup)  newtype QFieldAssignment be tbl a@@ -269,8 +270,8 @@ type Projectible be = ProjectibleWithPredicate AnyType be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) type ProjectibleValue be = ProjectibleWithPredicate ValueContext be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) -class ThreadRewritable (s :: *) (a :: *) | a -> s where-  type WithRewrittenThread s (s' :: *) a :: *+class ThreadRewritable (s :: Type) (a :: Type) | a -> s where+  type WithRewrittenThread s (s' :: Type) a :: Type    rewriteThread :: Proxy s' -> a -> WithRewrittenThread s s' a instance Beamable tbl => ThreadRewritable s (tbl (QGenExpr ctxt syntax s)) where@@ -341,7 +342,7 @@     , rewriteThread s' e, rewriteThread s' f, rewriteThread s' g, rewriteThread s' h )  class ContextRewritable a where-  type WithRewrittenContext a ctxt :: *+  type WithRewrittenContext a ctxt :: Type    rewriteContext :: Proxy ctxt -> a -> WithRewrittenContext a ctxt instance Beamable tbl => ContextRewritable (tbl (QGenExpr old syntax s)) where@@ -425,7 +426,7 @@   { fromBeamSqlBackendWindowFrameSyntax :: BeamSqlBackendWindowFrameSyntax be   } -class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) be res a | a -> be where+class ProjectibleWithPredicate (contextPredicate :: Type -> Constraint) be res a | a -> be where   project' :: Monad m => Proxy contextPredicate -> Proxy (be, res)            -> (forall context. contextPredicate context =>                Proxy context -> Proxy be -> res -> m res)@@ -592,7 +593,7 @@     zipBeamFieldsM (\_ _ -> Columnar' . QField False "" <$> mkM (Proxy @()) (Proxy @()))                    (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t) -instance Beamable t => ProjectibleWithPredicate AnyType () T.Text (t (Const T.Text)) where+instance Beamable t => ProjectibleWithPredicate AnyType () res (t (Const res)) where   project' _ be mutateM a =     zipBeamFieldsM (\(Columnar' f) _ ->                       Columnar' <$> project' (Proxy @AnyType) be mutateM f) a a@@ -610,7 +611,7 @@     zipBeamFieldsM (\_ _ -> Columnar' . Const <$> mkM (Proxy @()) (Proxy @()))                    (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t) -instance ProjectibleWithPredicate AnyType () T.Text (Const T.Text a) where+instance ProjectibleWithPredicate AnyType () res (Const res a) where   project' _ _ mutateM (Const a) = Const <$> mutateM (Proxy @()) (Proxy @()) a    projectSkeleton' _ _ mkM =@@ -665,3 +666,6 @@                     -> name  tableNameFromEntity = tableName <$> dbTableSchema <*> dbTableCurrentName++rescopeQ :: QM be db s res -> QM be db s' res+rescopeQ = unsafeCoerce

@@ -20,7 +20,8 @@ -- -- > x >*. allOf_ .. module Database.Beam.Query.Ord-  ( SqlEq(..), SqlEqQuantified(..)+  ( SqlEq(..), SqlEqQuantified(..), SqlIn(..)+  , HasSqlInTable(..)   , SqlOrd(..), SqlOrdQuantified(..)   , QQuantified(..) @@ -38,8 +39,7 @@   , allOf_, allIn_    , between_--  , in_ ) where+  ) where  import Database.Beam.Query.Internal import Database.Beam.Query.Types@@ -173,14 +173,32 @@ between_ (QExpr a) (QExpr min_) (QExpr max_) =   QExpr (liftA3 betweenE a min_ max_) --- | SQL @IN@ predicate-in_ :: BeamSqlBackend be-    => QGenExpr context be s a-    -> [ QGenExpr context be s a ]-    -> QGenExpr context be s Bool-in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False)))-in_ (QExpr row) options = QExpr (inE <$> row <*> mapM (\(QExpr o) -> o) options)+class SqlIn expr a | a -> expr where+  -- | SQL @IN@ predicate+  in_ :: a -> [ a ] -> expr Bool +instance BeamSqlBackend be => SqlIn (QGenExpr context be s) (QGenExpr context be s a) where+  in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False)))+  in_ (QExpr row) options = QExpr (inE <$> row <*> mapM (\(QExpr o) -> o) options)++-- | Class for backends which support SQL @IN@ on lists of row values, which is+-- not part of ANSI SQL. This is useful for @IN@ on primary keys.+class BeamSqlBackend be => HasSqlInTable be where+  inRowValuesE+    :: Proxy be+    -> BeamSqlBackendExpressionSyntax be+    -> [ BeamSqlBackendExpressionSyntax be ]+    -> BeamSqlBackendExpressionSyntax be+  inRowValuesE Proxy = inE++instance ( HasSqlInTable be, Beamable table ) =>+  SqlIn (QGenExpr context be s) (table (QGenExpr context be s)) where++  in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False)))+  in_ row options = QExpr (inRowValuesE (Proxy @be) <$> toExpr row <*> (mapM toExpr options))+    where toExpr :: table (QGenExpr context be s) -> TablePrefix -> BeamSqlBackendExpressionSyntax be+          toExpr = fmap rowE . sequence . allBeamValues (\(Columnar' (QExpr x)) -> x)+ infix 4 `between_`, `in_`  -- | Class for expression types or expression containers for which there is a@@ -207,7 +225,7 @@   -- | Quantified equality and inequality using /SQL semantics/ (tri-state boolean)   (==*.), (/=*.) :: a -> quantified -> expr SqlBool -infix 4 ==., /=., ==*., /=*.+infix 4 ==., /=., ==?., /=?., ==*., /=*. infix 4 <., >., <=., >=. infix 4 <*., >*., <=*., >=*. @@ -293,7 +311,7 @@          SqlEq (QGenExpr context be s) (tbl (QGenExpr context be s)) where    a ==. b = let (_, e) = runState (zipBeamFieldsM-                                   (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->+                                   (\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->                                        do modify (\expr ->                                                     case expr of                                                       Nothing -> Just $ x ==. y@@ -303,7 +321,7 @@   a /=. b = not_ (a ==. b)    a ==?. b = let (_, e) = runState (zipBeamFieldsM-                                    (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->+                                    (\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->                                         do modify (\expr ->                                                      case expr of                                                        Nothing -> Just $ x ==?. y@@ -317,7 +335,7 @@     => SqlEq (QGenExpr context be s) (tbl (Nullable (QGenExpr context be s))) where    a ==. b = let (_, e) = runState (zipBeamFieldsM-                                      (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) -> do+                                      (\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) -> do                                           modify (\expr ->                                                     case expr of                                                       Nothing -> Just $ x ==. y@@ -328,7 +346,7 @@   a /=. b = not_ (a ==. b)    a ==?. b = let (_, e) = runState (zipBeamFieldsM-                                    (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->+                                    (\x'@(Columnar' (Columnar' HasConstraint :*: Columnar' x)) (Columnar' y) ->                                         do modify (\expr ->                                                      case expr of                                                        Nothing -> Just $ x ==?. y

@@ -1,7 +1,7 @@ -- | Combinators and types specific to relationships. -- --   These types and functions correspond with the relationships section in the---   <http://tathougies.github.io/beam/user-guide/queries/relationships/ user guide>.+--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ user guide>. module Database.Beam.Query.Relationships   ( -- * Relationships @@ -33,7 +33,7 @@  -- | Convenience type to declare one-to-many relationships. See the manual --   section on---   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships>+--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information type OneToMany be db s one many =   ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool ) =>@@ -45,7 +45,7 @@  -- | Convenience type to declare one-to-many relationships with a nullable --   foreign key. See the manual section on---   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships>+--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information type OneToManyOptional be db s tbl rel =   ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool@@ -88,7 +88,7 @@  -- | Convenience type to declare many-to-many relationships. See the manual --   section on---   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships>+--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information type ManyToMany be db left right =   forall s.@@ -101,7 +101,7 @@  -- | Convenience type to declare many-to-many relationships with additional --   data. See the manual section on---   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships>+--   <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information type ManyToManyThrough be db through left right =   forall s.@@ -116,8 +116,8 @@ --   Takes the join table and two key extraction functions from that table to the --   related tables. Also takes two `Q`s representing the table sources to relate. -----   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual>---   for more indformation.+--   See <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ the manual>+--   for more information. manyToMany_   :: ( Database be db      , Table joinThrough, Table left, Table right@@ -137,8 +137,8 @@ --   join table and two key extraction functions from that table to the related --   tables. Also takes two `Q`s representing the table sources to relate. -----   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual>---   for more indformation.+--   See <https://haskell-beam.github.io/beam/user-guide/queries/relationships/ the manual>+--   for more information. manyToManyPassthrough_   :: ( Database be db      , Table joinThrough, Table left, Table right

@@ -12,11 +12,7 @@ import           Control.Monad.Free.Church import           Control.Monad.Free -#if !MIN_VERSION_base(4, 11, 0)-import           Control.Monad.Writer hiding ((<>))-import           Data.Semigroup-#endif-+import           Data.Kind (Type) import           Data.Maybe import           Data.Proxy (Proxy(Proxy)) import           Data.String@@ -52,7 +48,7 @@   , qbFrom  :: Maybe (BeamSqlBackendFromSyntax be)   , qbWhere :: Maybe (BeamSqlBackendExpressionSyntax be) } -data SelectBuilder be (db :: (* -> *) -> *) a where+data SelectBuilder be (db :: (Type -> Type) -> Type) a where   SelectBuilderQ :: ( BeamSqlBackend be                     , Projectible be a )                  => a -> QueryBuilder be -> SelectBuilder be db a

@@ -47,7 +47,7 @@ -- $db-construction -- Types and functions to express database types and auto-generate name mappings -- for them. See the--- [manual](https://tathougies.github.io/beam/user-guide/databases.md) for more+-- [manual](https://haskell-beam.github.io/beam/user-guide/databases.md) for more -- information.  -- $entities

@@ -10,13 +10,14 @@  import Control.Monad.Identity +import Data.Kind (Type) import Data.Proxy  import GHC.Generics  import Lens.Micro hiding (to) -class GTableLenses t (m :: * -> *) a (lensType :: * -> *) where+class GTableLenses t (m :: Type -> Type) a (lensType :: Type -> Type) where     gTableLenses :: Proxy a -> Lens' (t m) (a p) -> lensType () instance GTableLenses t m a al => GTableLenses t m (M1 s d a) (M1 s d al) where     gTableLenses (Proxy :: Proxy (M1 s d a)) lensToHere = M1 $ gTableLenses (Proxy :: Proxy a) (\f -> lensToHere (\(M1 x) -> M1 <$> f x))

@@ -24,6 +24,7 @@     , dbModification, tableModification, withDbModification     , withTableModification, modifyTable, modifyEntityName     , setEntityName, modifyTableFields, fieldNamed+    , modifyEntitySchema, setEntitySchema     , defaultDbSettings      , RenamableWithRule(..), RenamableField(..)@@ -43,6 +44,7 @@     , GFieldsFulfillConstraint(..), FieldsFulfillConstraint     , FieldsFulfillConstraintNullable     , WithConstraint(..)+    , HasConstraint(..)     , TagReducesTo(..), ReplaceBaseTag     , withConstrainedFields, withConstraints     , withNullableConstrainedFields, withNullableConstraints@@ -60,6 +62,7 @@  import           Database.Beam.Backend.Types +import           Control.Applicative (liftA2) import           Control.Arrow (first) import           Control.Monad.Identity import           Control.Monad.Writer hiding ((<>))@@ -67,11 +70,7 @@ import           Data.Char (isUpper, toLower) import           Data.Foldable (fold) import qualified Data.List.NonEmpty as NE-import           Data.Monoid (Endo(..)) import           Data.Proxy-#if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup-#endif import           Data.String (IsString(..)) import           Data.Text (Text) import qualified Data.Text as T@@ -87,9 +86,10 @@  -- | Allows introspection into database types. -----   All database types must be of kind '(* -> *) -> *'. If the type parameter---   is named 'f', each field must be of the type of 'f' applied to some type---   for which an 'IsDatabaseEntity' instance exists.+--   All database types must be of kind '(Type -> Type) -> Type'. If+--   the type parameter 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@@ -97,25 +97,25 @@ -- --   Entities are documented under [the corresponding --   section](Database.Beam.Schema#entities) and in the---   [manual](http://tathougies.github.io/beam/user-guide/databases/)+--   [manual](https://haskell-beam.github.io/beam/user-guide/databases/) class Database be db where      -- | Default derived function. Do not implement this yourself.     --     --   The idea is that, for any two databases over particular entity tags 'f'     --   and 'g', if we can take any entity in 'f' and 'g' to the corresponding-    --   entity in 'h' (in the possibly effectful monad 'm'), then we can+    --   entity in 'h' (in the possibly effectful applicative functor 'm'), then we can     --   transform the two databases over 'f' and 'g' to a database in 'h',-    --   within the monad 'm'.+    --   within 'm'.     --     --   If that doesn't make sense, don't worry. This is mostly beam internal-    zipTables :: Monad m+    zipTables :: Applicative m               => Proxy be               -> (forall tbl. (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) =>                   f tbl -> g tbl -> m (h tbl))               -> db f -> db g -> m (db h)     default zipTables :: ( Generic (db f), Generic (db g), Generic (db h)-                         , Monad m+                         , Applicative m                          , GZipDatabase be f g h                                         (Rep (db f)) (Rep (db g)) (Rep (db h)) ) =>                          Proxy be ->@@ -134,7 +134,7 @@ -- | Automatically provide names for tables, and descriptions for tables (using --   'defTblFieldSettings'). Your database must implement 'Generic', and must be --   auto-derivable. For more information on name generation, see the---   [manual](https://tathougies.github.io/beam/user-guide/models)+--   [manual](https://haskell-beam.github.io/beam/user-guide/models) defaultDbSettings :: ( Generic (DatabaseSettings be db)                      , GAutoDbSettings (Rep (DatabaseSettings be db) ()) ) =>                      DatabaseSettings be db@@ -219,10 +219,17 @@ modifyEntityName :: IsDatabaseEntity be entity => (Text -> Text) -> EntityModification (DatabaseEntity be db) be entity modifyEntityName modTblNm = EntityModification (Endo (\(DatabaseEntity tbl) -> DatabaseEntity (tbl & dbEntityName %~ modTblNm))) +-- | Construct an 'EntityModification' to set the schema of a database entity+modifyEntitySchema :: IsDatabaseEntity be entity => (Maybe Text -> Maybe Text) -> EntityModification (DatabaseEntity be db) be entity+modifyEntitySchema modSchema = EntityModification (Endo (\(DatabaseEntity tbl) -> DatabaseEntity (tbl & dbEntitySchema %~ modSchema)))+ -- | Change the entity name without consulting the beam-assigned one setEntityName :: IsDatabaseEntity be entity => Text -> EntityModification (DatabaseEntity be db) be entity setEntityName nm = modifyEntityName (\_ -> nm) +setEntitySchema :: IsDatabaseEntity be entity => Maybe Text -> EntityModification (DatabaseEntity be db) be entity+setEntitySchema nm = modifyEntitySchema (\_ -> nm)+ -- | Construct an 'EntityModification' to rename the fields of a 'TableEntity' modifyTableFields :: tbl (FieldModification (TableField tbl)) -> EntityModification (DatabaseEntity be db) be (TableEntity tbl) modifyTableFields modFields = EntityModification (Endo (\(DatabaseEntity tbl@(DatabaseTable {})) -> DatabaseEntity tbl { dbTableSettings = withTableModification modFields (dbTableSettings tbl) }))@@ -264,11 +271,11 @@ -- * Database entity types  -- | An entity tag for tables. See the documentation for 'Table' or consult the---   [manual](https://tathougies.github.io/beam/user-guide/models) for more.-data TableEntity (tbl :: (* -> *) -> *)-data ViewEntity (view :: (* -> *) -> *)+--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for more.+data TableEntity (tbl :: (Type -> Type) -> Type)+data ViewEntity (view :: (Type -> Type) -> Type) --data UniqueConstraint (tbl :: (* -> *) -> *) (c :: (* -> *) -> *)-data DomainTypeEntity (ty :: *)+data DomainTypeEntity (ty :: Type) --data CharacterSetEntity --data CollationEntity --data TranslationEntity@@ -276,7 +283,7 @@  class RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be entityType)) =>     IsDatabaseEntity be entityType where-  data DatabaseEntityDescriptor be entityType :: *+  data DatabaseEntityDescriptor be entityType :: Type   type DatabaseEntityDefaultRequirements be entityType :: Constraint   type DatabaseEntityRegularRequirements be entityType :: Constraint @@ -363,7 +370,7 @@ -- | Represents a meta-description of a particular entityType. Mostly, a wrapper --   around 'DatabaseEntityDescriptor be entityType', but carries around the --   'IsDatabaseEntity' dictionary.-data DatabaseEntity be (db :: (* -> *) -> *) entityType  where+data DatabaseEntity be (db :: (Type -> Type) -> Type) entityType  where     DatabaseEntity ::       IsDatabaseEntity be entityType =>       DatabaseEntityDescriptor be entityType ->  DatabaseEntity be db entityType@@ -392,7 +399,7 @@     where name = T.pack (selName (undefined :: S1 f (K1 Generic.R (DatabaseEntity be db x)) p))  class GZipDatabase be f g h x y z where-  gZipDatabase :: Monad m =>+  gZipDatabase :: Applicative m =>                   (Proxy f, Proxy g, Proxy h, Proxy be)                -> (forall tbl. (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) => f tbl -> g tbl -> m (h tbl))                -> x () -> y () -> m (z ())@@ -403,16 +410,14 @@          , GZipDatabase be f g h bx by bz ) =>   GZipDatabase be f g h (ax :*: bx) (ay :*: by) (az :*: bz) where   gZipDatabase p combine ~(ax :*: bx) ~(ay :*: by) =-    do a <- gZipDatabase p combine ax ay-       b <- gZipDatabase p combine bx by-       pure (a :*: b)+    liftA2 (:*:) (gZipDatabase p combine ax ay) (gZipDatabase p combine bx by) instance (IsDatabaseEntity be tbl, DatabaseEntityRegularRequirements be tbl) =>   GZipDatabase be f g h (K1 Generic.R (f tbl)) (K1 Generic.R (g tbl)) (K1 Generic.R (h tbl)) where    gZipDatabase _ combine ~(K1 x) ~(K1 y) =     K1 <$> combine x y -data Lenses (t :: (* -> *) -> *) (f :: * -> *) x+data Lenses (t :: (Type -> Type) -> Type) (f :: Type -> Type) x data LensFor t x where     LensFor :: Generic t => Lens' t x -> LensFor t x @@ -454,7 +459,7 @@ --   turned into query expressions. -- --   The other rules are used within Beam to provide lenses and to expose the inner structure of the data type.-type family Columnar (f :: * -> *) x where+type family Columnar (f :: Type -> Type) x where     Columnar Exposed x = Exposed x      Columnar Identity x = x@@ -492,7 +497,7 @@ --   naming convention for you, and then modify it with 'withDbModification' if --   necessary. Under this scheme, the field n be renamed using the 'IsString' --   instance for 'TableField', or the 'fieldNamed' function.-data TableField (table :: (* -> *) -> *) ty+data TableField (table :: (Type -> Type) -> Type) ty   = TableField   { _fieldPath :: NE.NonEmpty T.Text     -- ^ The path that led to this field. Each element is the haskell@@ -539,12 +544,15 @@  -- | The big Kahuna! All beam tables implement this class. -----   The kind of all table types is '(* -> *) -> *'. This is because all table types are actually /table type constructors/.---   Every table type takes in another type constructor, called the /column tag/, and uses that constructor to instantiate the column types.---   See the documentation for 'Columnar'.+--   The kind of all table types is '(Type -> Type) -> Type'. This is+--   because all table types are actually /table type constructors/.+--   Every table type takes in another type constructor, called the+--   /column tag/, and uses that constructor to instantiate the column+--   types.  See the documentation for 'Columnar'. -----   This class is mostly Generic-derivable. You need only specify a type for the table's primary key and a method to extract the primary key---   given the table.+--   This class is mostly Generic-derivable. You need only specify a+--   type for the table's primary key and a method to extract the+--   primary key given the table. -- --   An example table: --@@ -569,11 +577,11 @@ --       `_blogPostTagline` is declared 'Maybe' so 'Nothing' will be stored as NULL in the database. `_blogPostImageGallery` will be allowed to be empty because it uses the 'Nullable' tag modifier. --     * `blogPostAuthor` references the `AuthorT` table (not given here) and is required. --     * `blogPostImageGallery` references the `ImageGalleryT` table (not given here), but this relation is not required (i.e., it may be 'Nothing'. See 'Nullable').-class (Typeable table, Beamable table, Beamable (PrimaryKey table)) => Table (table :: (* -> *) -> *) where+class (Typeable table, Beamable table, Beamable (PrimaryKey table)) => Table (table :: (Type -> Type) -> Type) where      -- | A data type representing the types of primary keys for this table.     --   In order to play nicely with the default deriving mechanism, this type must be an instance of 'Generic'.-    data PrimaryKey table (column :: * -> *) :: *+    data PrimaryKey table (column :: Type -> Type) :: Type      -- | Given a table, this should return the PrimaryKey from the table. By keeping this polymorphic over column,     --   we ensure that the primary key values come directly from the table (i.e., they can't be arbitrary constants)@@ -583,7 +591,7 @@ --   to "zip" tables with different column tags together. Always instantiate an --   empty 'Beamable' instance for tables, primary keys, and any type that you --   would like to embed within either. See the---   [manual](https://tathougies.github.io/beam/user-guide/models) for more+--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for more --   information on embedding. class Beamable table where     zipBeamFieldsM :: Applicative m =>@@ -629,12 +637,12 @@   zipBeamFieldsM (\x y -> pure (Columnar' (x :*: y))) a b  class Retaggable f x | x -> f where-  type Retag (tag :: (* -> *) -> * -> *) x :: *+  type Retag (tag :: (Type -> Type) -> Type -> Type) x :: Type    retag :: (forall a. Columnar' f a -> Columnar' (tag f) a) -> x         -> Retag tag x -instance Beamable tbl => Retaggable f (tbl (f :: * -> *)) where+instance Beamable tbl => Retaggable f (tbl (f :: Type -> Type)) where   type Retag tag (tbl f) = tbl (tag f)    retag = changeBeamRep@@ -701,54 +709,58 @@     ( retag transform a, retag transform b, retag transform c, retag transform d     , retag transform e, retag transform f, retag transform g, retag transform h ) --- Carry a constraint instance-data WithConstraint (c :: * -> Constraint) x where+-- | Carry a constraint instance and the value it applies to.+data WithConstraint (c :: Type -> Constraint) x where   WithConstraint :: c x => x -> WithConstraint c x -class GFieldsFulfillConstraint (c :: * -> Constraint) (exposed :: * -> *) values withconstraint where-  gWithConstrainedFields :: Proxy c -> Proxy exposed -> values () -> withconstraint ()-instance GFieldsFulfillConstraint c exposed values withconstraint =>-    GFieldsFulfillConstraint c (M1 s m exposed) (M1 s m values) (M1 s m withconstraint) where-  gWithConstrainedFields c _ (M1 x) = M1 (gWithConstrainedFields c (Proxy @exposed) x)-instance GFieldsFulfillConstraint c U1 U1 U1 where-  gWithConstrainedFields _ _ _ = U1-instance (GFieldsFulfillConstraint c aExp a aC, GFieldsFulfillConstraint c bExp b bC) =>-  GFieldsFulfillConstraint c (aExp :*: bExp) (a :*: b) (aC :*: bC) where-  gWithConstrainedFields be _ (a :*: b) = gWithConstrainedFields be (Proxy @aExp) a :*: gWithConstrainedFields be (Proxy @bExp) b-instance (c x) => GFieldsFulfillConstraint c (K1 Generic.R (Exposed x)) (K1 Generic.R x) (K1 Generic.R (WithConstraint c x)) where-  gWithConstrainedFields _ _ (K1 x) = K1 (WithConstraint x)+-- | Carry a constraint instance.+data HasConstraint (c :: Type -> Constraint) x where+  HasConstraint :: c x => HasConstraint c x++class GFieldsFulfillConstraint (c :: Type -> Constraint) (exposed :: Type -> Type) withconstraint where+  gWithConstrainedFields :: Proxy c -> Proxy exposed -> withconstraint ()+instance GFieldsFulfillConstraint c exposed withconstraint =>+    GFieldsFulfillConstraint c (M1 s m exposed) (M1 s m withconstraint) where+  gWithConstrainedFields c _ = M1 (gWithConstrainedFields c (Proxy @exposed))+instance GFieldsFulfillConstraint c U1 U1 where+  gWithConstrainedFields _ _ = U1+instance (GFieldsFulfillConstraint c aExp aC, GFieldsFulfillConstraint c bExp bC) =>+  GFieldsFulfillConstraint c (aExp :*: bExp) (aC :*: bC) where+  gWithConstrainedFields be _ = gWithConstrainedFields be (Proxy @aExp) :*: gWithConstrainedFields be (Proxy @bExp)+instance (c x) => GFieldsFulfillConstraint c (K1 Generic.R (Exposed x)) (K1 Generic.R (HasConstraint c x)) where+  gWithConstrainedFields _ _ = K1 HasConstraint instance FieldsFulfillConstraint c t =>-    GFieldsFulfillConstraint c (K1 Generic.R (t Exposed)) (K1 Generic.R (t Identity)) (K1 Generic.R (t (WithConstraint c))) where-  gWithConstrainedFields _ _ (K1 x) = K1 (to (gWithConstrainedFields (Proxy @c) (Proxy @(Rep (t Exposed))) (from x)))+    GFieldsFulfillConstraint c (K1 Generic.R (t Exposed)) (K1 Generic.R (t (HasConstraint c))) where+  gWithConstrainedFields _ _ = K1 (to (gWithConstrainedFields (Proxy @c) (Proxy @(Rep (t Exposed))))) 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)))+    GFieldsFulfillConstraint c (K1 Generic.R (t (Nullable Exposed))) (K1 Generic.R (t (Nullable (HasConstraint c)))) where+  gWithConstrainedFields _ _ = K1 (to (gWithConstrainedFields (Proxy @c) (Proxy @(Rep (t (Nullable Exposed))))))  withConstrainedFields :: forall c tbl-                       . FieldsFulfillConstraint c tbl => tbl Identity -> tbl (WithConstraint c)-withConstrainedFields =-  to . gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl Exposed))) . from+                       . (FieldsFulfillConstraint c tbl, Beamable tbl) => tbl Identity -> tbl (WithConstraint c)+withConstrainedFields = runIdentity . zipBeamFieldsM f (withConstraints @c @tbl)+  where f :: forall a. Columnar' (HasConstraint c) a -> Columnar' Identity a -> Identity (Columnar' (WithConstraint c) a)+        f (Columnar' HasConstraint) (Columnar' a) = Identity $ Columnar' $ WithConstraint a -withConstraints :: forall c tbl. (Beamable tbl, FieldsFulfillConstraint c tbl) => tbl (WithConstraint c)-withConstraints =-  withConstrainedFields (changeBeamRep (\_ -> Columnar' undefined) tblSkeleton)+withConstraints :: forall c tbl. (Beamable tbl, FieldsFulfillConstraint c tbl) => tbl (HasConstraint c)+withConstraints = to $ gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl Exposed)))  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+                               . (FieldsFulfillConstraintNullable c tbl, Beamable tbl) => tbl (Nullable Identity) -> tbl (Nullable (WithConstraint c))+withNullableConstrainedFields = runIdentity . zipBeamFieldsM f (withNullableConstraints @c @tbl)+  where f :: forall a. Columnar' (Nullable (HasConstraint c)) a -> Columnar' (Nullable Identity) a -> Identity (Columnar' (Nullable (WithConstraint c)) a)+        f (Columnar' HasConstraint) (Columnar' a) = Identity $ Columnar' $ WithConstraint a -withNullableConstraints ::  forall c tbl. (Beamable tbl, FieldsFulfillConstraintNullable c tbl) => tbl (Nullable (WithConstraint c))-withNullableConstraints =-  withNullableConstrainedFields (changeBeamRep (\_ -> Columnar' undefined) tblSkeleton)+withNullableConstraints ::  forall c tbl. (Beamable tbl, FieldsFulfillConstraintNullable c tbl) => tbl (Nullable (HasConstraint c))+withNullableConstraints = to $ gWithConstrainedFields (Proxy @c) (Proxy @(Rep (tbl (Nullable Exposed)))) -type FieldsFulfillConstraint (c :: * -> Constraint) t =-  ( Generic (t (WithConstraint c)), Generic (t Identity), Generic (t Exposed)-  , GFieldsFulfillConstraint c (Rep (t Exposed)) (Rep (t Identity)) (Rep (t (WithConstraint c))))+type FieldsFulfillConstraint (c :: Type -> Constraint) t =+  ( Generic (t (HasConstraint c)), Generic (t Identity), Generic (t Exposed)+  , GFieldsFulfillConstraint c (Rep (t Exposed)) (Rep (t (HasConstraint c)))) -type FieldsFulfillConstraintNullable (c :: * -> Constraint) t =-  ( Generic (t (Nullable (WithConstraint c))), Generic (t (Nullable Identity)), Generic (t (Nullable Exposed))-  , GFieldsFulfillConstraint c (Rep (t (Nullable Exposed))) (Rep (t (Nullable Identity))) (Rep (t (Nullable (WithConstraint c)))))+type FieldsFulfillConstraintNullable (c :: Type -> Constraint) t =+  ( Generic (t (Nullable (HasConstraint c))), Generic (t (Nullable Identity)), Generic (t (Nullable Exposed))+  , GFieldsFulfillConstraint c (Rep (t (Nullable Exposed))) (Rep (t (Nullable (HasConstraint c)))))  -- | Synonym for 'primaryKey' pk :: Table t => t f -> PrimaryKey t f@@ -756,7 +768,7 @@  -- | Return a 'TableSettings' for the appropriate 'table' type where each column --   has been given its default name. See the---   [manual](https://tathougies.github.io/beam/user-guide/models) for+--   [manual](https://haskell-beam.github.io/beam/user-guide/models) for --   information on the default naming convention. defTblFieldSettings :: ( Generic (TableSettings table)                        , GDefaultTableFieldSettings (Rep (TableSettings table) ())) =>@@ -765,7 +777,7 @@     where withProxy :: (Proxy (Rep (TableSettings table) ()) -> TableSettings table) -> TableSettings table           withProxy f = f Proxy -class GZipTables f g h (exposedRep :: * -> *) fRep gRep hRep where+class GZipTables f g h (exposedRep :: Type -> Type) fRep gRep hRep where     gZipTables :: Applicative m => Proxy exposedRep                                 -> (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))                                 -> fRep ()@@ -850,20 +862,20 @@   | BeamableStrategy   | RecursiveKeyStrategy -type family ChooseSubTableStrategy (tbl :: (* -> *) -> *) (sub :: (* -> *) -> *) :: SubTableStrategy where+type family ChooseSubTableStrategy (tbl :: (Type -> Type) -> Type) (sub :: (Type -> Type) -> Type) :: SubTableStrategy where   ChooseSubTableStrategy tbl (PrimaryKey tbl) = 'RecursiveKeyStrategy   ChooseSubTableStrategy tbl (PrimaryKey rel) = 'PrimaryKeyStrategy   ChooseSubTableStrategy tbl sub = 'BeamableStrategy  -- TODO is this necessary-type family CheckNullable (f :: * -> *) :: Constraint where+type family CheckNullable (f :: Type -> Type) :: Constraint where   CheckNullable (Nullable f) = ()-  CheckNullable f = TypeError ('Text "Recursive reference without Nullable constraint forms an infinite loop." ':$$:+  CheckNullable f = TypeError ('Text "Recursive references without Nullable constraint form an infinite loop." ':$$:                                'Text "Hint: Only embed nullable 'PrimaryKey tbl' within the definition of 'tbl'." ':$$:                                'Text "      For example, replace 'PrimaryKey tbl f' with 'PrimaryKey tbl (Nullable f)'")  -class SubTableStrategyImpl (strategy :: SubTableStrategy) (f :: * -> *) sub where+class SubTableStrategyImpl (strategy :: SubTableStrategy) (f :: Type -> Type) sub where   namedSubTable :: Proxy strategy -> sub f  -- The defaulting with @TableField rel@ is necessary to avoid infinite loops

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                beam-core-version:             0.8.0.0+version:             0.9.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@@ -10,7 +10,7 @@                      well as the corresponding backend.                       For more information, see the user manual and tutorial on-                     <https://tathougies.github.io/beam GitHub pages>.+                     <https://haskell-beam.github.io/beam GitHub pages>. homepage:            http://travis.athougies.net/projects/beam.html license:             MIT license-file:        LICENSE@@ -19,12 +19,13 @@ category:            Database build-type:          Simple cabal-version:       1.18-bug-reports:         https://github.com/tathougies/beam/issues+bug-reports:         https://github.com/haskell-beam/beam/issues extra-doc-files:     ChangeLog.md  library   exposed-modules:     Database.Beam Database.Beam.Backend                        Database.Beam.Query+                       Database.Beam.Query.Adhoc                        Database.Beam.Query.Internal                        Database.Beam.Query.CustomSQL                        Database.Beam.Query.CTE@@ -46,6 +47,9 @@                        Database.Beam.Backend.SQL.SQL2003                        Database.Beam.Backend.SQL.Builder                        Database.Beam.Backend.SQL.AST++                       Database.Beam.Backend.Internal.Compat+   other-modules:       Database.Beam.Query.Aggregate                        Database.Beam.Query.Combinators                        Database.Beam.Query.Extensions@@ -55,31 +59,37 @@                        Database.Beam.Query.Relationships                         Database.Beam.Schema.Lenses-  build-depends:       base         >=4.7     && <5.0,++  build-depends:       base         >=4.9     && <5.0,                        aeson        >=0.11    && <1.5,-                       text         >=1.0     && <1.3,+                       text         >=1.2.2.0 && <1.3,                        bytestring   >=0.10    && <0.11,-                       mtl          >=2.1     && <2.3,+                       mtl          >=2.2.1   && <2.3,                        microlens    >=0.4     && <0.5,-                       ghc-prim     >=0.5     && <0.6,+                       ghc-prim     >=0.5     && <0.7,                        free         >=4.12    && <5.2,                        dlist        >=0.7.1.2 && <0.9,                        time         >=1.6     && <1.10,-                       hashable     >=1.1     && <1.3,+                       hashable     >=1.2.4.0 && <1.4,                        network-uri  >=2.6     && <2.7,                        containers   >=0.5     && <0.7,                        scientific   >=0.3     && <0.4,                        vector       >=0.11    && <0.13,-                       vector-sized >=0.5     && <1.3,+                       vector-sized >=0.5     && <1.5,                        tagged       >=0.8     && <0.9+   Default-language:    Haskell2010   default-extensions:  ScopedTypeVariables, OverloadedStrings, GADTs, RecursiveDo, FlexibleInstances, FlexibleContexts, TypeFamilies,                        GeneralizedNewtypeDeriving, RankNTypes, TupleSections, ConstraintKinds, StandaloneDeriving, TypeOperators,                        DefaultSignatures, KindSignatures, MultiParamTypeClasses, DeriveGeneric, DeriveFunctor, DeriveDataTypeable,                        TypeApplications, FunctionalDependencies, DataKinds, BangPatterns, InstanceSigs   ghc-options:         -Wall -O3+  if impl(ghc >= 8.8)+    ghc-options: -Wcompat   if flag(werror)     ghc-options:       -Werror+  if impl(ghc >= 8.10)+    default-extensions: TypeFamilyDependencies  flag werror   description: Enable -Werror during development@@ -99,5 +109,5 @@  source-repository head   type: git-  location: https://github.com/tathougies/beam.git+  location: https://github.com/haskell-beam/beam.git   subdir: beam-core

@@ -10,10 +10,10 @@ import Database.Beam.Test.Schema hiding (tests)  import Database.Beam-import Database.Beam.Query.Internal import Database.Beam.Backend.SQL (MockSqlBackend) import Database.Beam.Backend.SQL.AST +import Data.Int import Data.Time.Clock import Data.Text (Text) @@ -113,7 +113,7 @@      Just (FromTable (TableNamed (TableName Nothing "employees")) (Just (employees, Nothing))) <- pure selectFrom       let salaryCond = ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField employees "salary")) (ExpressionValue (Value (120202 :: Double)))-         ageCond = ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField employees "age")) (ExpressionValue (Value (30 :: Int)))+         ageCond = ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField employees "age")) (ExpressionValue (Value (30 :: Int32)))          nameCond = ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField employees "first_name")) (ExpressionFieldName (QualifiedField employees "last_name"))       selectWhere @?= Just (ExpressionBinOp "AND" salaryCond (ExpressionBinOp "AND" ageCond nameCond))@@ -275,7 +275,7 @@                           , selectOrdering = [] } <-            pure $ selectMock $            do (age, maxNameLength) <- aggregate_ (\e -> ( group_ (_employeeAge e)-                                                        , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $+                                                        , fromMaybe_ 0 (max_ (as_ @Int32 (charLength_ (_employeeFirstName e))))) ) $                                       all_ (_employees employeeDbSettings)               guard_ (maxNameLength >. 42)               pure (age, maxNameLength)@@ -283,13 +283,13 @@          Just (FromTable (TableNamed (TableName Nothing "employees")) (Just (t0, Nothing))) <- pure selectFrom          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "age"), Just "res0" )                                         , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ]-                                                               , ExpressionValue (Value (0 :: Int)) ], Just "res1" ) ]+                                                               , ExpressionValue (Value (0 :: Int32)) ], Just "res1" ) ]          selectWhere @?= Nothing          selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField t0 "age") ])          selectHaving @?= Just (ExpressionCompOp ">" Nothing                                 (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ]-                                                    , ExpressionValue (Value (0 :: Int)) ])-                                (ExpressionValue (Value (42 :: Int))))+                                                    , ExpressionValue (Value (0 :: Int32)) ])+                                (ExpressionValue (Value (42 :: Int32))))      aggregateInJoin =       testCase "Aggregate in JOIN" $@@ -399,24 +399,24 @@            pure $ selectMock $            filter_ (\(_, l) -> l <. 10 ||. l >. 20) $            aggregate_ (\e -> ( group_ (_employeeAge e)-                             , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $+                             , fromMaybe_ 0 (max_ (as_ @Int32 (charLength_ (_employeeFirstName e))))) ) $            limit_ 10 (all_ (_employees employeeDbSettings))          Just (FromTable (TableFromSubSelect subselect) (Just (t0, Nothing))) <- pure selectFrom           selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "res3"),Just "res0")                                         , (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0"))]-                                                              , ExpressionValue (Value (0 :: Int)) ], Just "res1")+                                                              , ExpressionValue (Value (0 :: Int32)) ], Just "res1")                                         ]          selectWhere @?= Nothing          selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "res3")])          selectHaving @?= Just (ExpressionBinOp "OR" (ExpressionCompOp "<" Nothing                                                       (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ]-                                                                          , ExpressionValue (Value (0 :: Int)) ])-                                                      (ExpressionValue (Value (10 :: Int))))+                                                                          , ExpressionValue (Value (0 :: Int32)) ])+                                                      (ExpressionValue (Value (10 :: Int32))))                                                      (ExpressionCompOp ">" Nothing                                                       (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ]-                                                                          , ExpressionValue (Value (0 :: Int)) ])-                                                      (ExpressionValue (Value (20 :: Int)))))+                                                                          , ExpressionValue (Value (0 :: Int32)) ])+                                                      (ExpressionValue (Value (20 :: Int32)))))           selectLimit subselect @?= Just 10          selectOffset subselect @?= Nothing@@ -446,7 +446,7 @@            pure $ selectMock $            do (lastName, firstNameLength) <-                   filter_ (\(_, charLength) -> fromMaybe_ 0 charLength >. 10) $-                  aggregate_ (\e -> (group_ (_employeeLastName e), max_ (charLength_ (_employeeFirstName e)))) $+                  aggregate_ (\e -> (group_ (_employeeLastName e), max_ (as_ @Int32 (charLength_ (_employeeFirstName e))))) $                   limit_ 10 (all_ (_employees employeeDbSettings))               role <- relatedBy_ (_roles employeeDbSettings) (\r -> _roleName r ==. lastName)               pure (firstNameLength, role, lastName)@@ -474,8 +474,8 @@          Just (FromTable (TableFromSubSelect employeesSelect) (Just (t0', Nothing))) <- pure selectFrom          selectWhere @?= Nothing          selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))]-                                                                                 , ExpressionValue (Value (0 :: Int)) ])-                                                             (ExpressionValue (Value (10 :: Int))))+                                                                                 , ExpressionValue (Value (0 :: Int32)) ])+                                                             (ExpressionValue (Value (10 :: Int32))))          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" ) ]@@ -507,7 +507,7 @@               (lastName, firstNameLength) <-                   filter_ (\(_, charLength) -> charLength >. 10) $                   aggregate_ (\e -> ( group_ (_employeeLastName e)-                                    , fromMaybe_ 0 $ max_ (charLength_ (_employeeFirstName e))) ) $+                                    , fromMaybe_ 0 $ max_ (as_ @Int32 (charLength_ (_employeeFirstName e)))) ) $                   limit_ 10 (all_ (_employees employeeDbSettings))               guard_ (_roleName role ==. lastName)               pure (firstNameLength, role, lastName)@@ -517,7 +517,7 @@                          Nothing) <-            pure selectFrom          selectWhere @?= Just (ExpressionBinOp "AND"-                               (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField t1 "res1")) (ExpressionValue (Value (10 :: Int))))+                               (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField t1 "res1")) (ExpressionValue (Value (10 :: Int32))))                                (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField t0 "name")) (ExpressionFieldName (QualifiedField t1 "res0"))))          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t1 "res1"), Just "res0" )                                         , ( ExpressionFieldName (QualifiedField t0 "for_employee__first_name"), Just "res1" )@@ -538,7 +538,7 @@          selectGrouping @?= Just (Grouping [ (ExpressionFieldName (QualifiedField t0' "res1")) ])          selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0' "res1"), Just "res0" )                                         , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))]-                                                               , ExpressionValue (Value (0 :: Int)) ]+                                                               , ExpressionValue (Value (0 :: Int32)) ]                                           , Just "res1" ) ]           Select { selectTable = SelectTable { .. }, selectLimit = Just 10@@ -753,7 +753,7 @@                       , selectOrdering = [] } <-        pure $ selectMock $        do (age, maxFirstNameLength) <- filter_ (\(_, nameLength) -> fromMaybe_ 0 nameLength >=. 20) $-                                       aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $+                                       aggregate_ (\e -> (group_ (_employeeAge e), max_ (as_ @Int32 (charLength_ (_employeeFirstName e))))) $                                        all_ (_employees employeeDbSettings)           role <- all_ (_roles employeeDbSettings)           pure (age, maxFirstNameLength, _roleName role)@@ -779,8 +779,8 @@      selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "age")])      selectHaving @?= Just (ExpressionCompOp ">=" Nothing                             (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))]-                                                , ExpressionValue (Value (0 :: Int)) ])-                            (ExpressionValue (Value (20 :: Int))))+                                                , ExpressionValue (Value (0 :: Int32)) ])+                            (ExpressionValue (Value (20 :: Int32))))  -- | Ensure that isJustE and isNothingE work correctly for simple types @@ -913,7 +913,7 @@      fieldNamesCapturedCorrectly =       testCase "UNION field names are propagated correctly" $-      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) )+      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int32, QExpr Expression s (Maybe _) )              hireDates = do e <- all_ (_employees employeeDbSettings)                             pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e))              leaveDates = do e <- all_ (_employees employeeDbSettings)@@ -928,11 +928,11 @@          Just (FromTable (TableFromSubSelect subselect) (Just (subselectTbl, Nothing))) <- pure selectFrom          selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField subselectTbl "res0"), Just "res0")                                         , (ExpressionBinOp "+" (ExpressionFieldName (QualifiedField subselectTbl "res1"))-                                                               (ExpressionValue (Value (23 :: Int))), Just "res1")+                                                               (ExpressionValue (Value (23 :: Int32))), Just "res1")                                         , (ExpressionFieldName (QualifiedField subselectTbl "res2"), Just "res2") ]          selectHaving @?= Nothing          selectGrouping @?= Nothing-         selectWhere @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField subselectTbl "res1")) (ExpressionValue (Value (22 :: Int))))+         selectWhere @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField subselectTbl "res1")) (ExpressionValue (Value (22 :: Int32))))           Select { selectTable = UnionTables False hireDatesQuery leaveDatesQuery                 , selectLimit = Just 10, selectOffset = Nothing@@ -976,7 +976,7 @@      equalProjectionsDontHaveSubSelects =       testCase "Equal projections dont have sub-selects" $-      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Text, QExpr Expression s Int )+      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Text, QExpr Expression s Int32 )              hireDates = do e <- all_ (_employees employeeDbSettings)                             pure (_employeeFirstName e, _employeeLastName e, _employeeAge e)              leaveDates = do e <- all_ (_employees employeeDbSettings)@@ -990,7 +990,7 @@      unionWithGuards =       testCase "UNION with guards" $-      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) )+      do let -- leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int32, QExpr Expression s (Maybe _) )              hireDates = do e <- all_ (_employees employeeDbSettings)                             pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e))              leaveDates = do e <- all_ (_employees employeeDbSettings)@@ -1023,7 +1023,7 @@          proj @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "res0"), Just "res0" )                             , ( ExpressionFieldName (QualifiedField t0 "res1"), Just "res1" )                             , ( ExpressionFieldName (QualifiedField t0 "res2"), Just "res2" ) ]-         where_ @?= ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "res1")) (ExpressionValue (Value (40 :: Int)))+         where_ @?= ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "res1")) (ExpressionValue (Value (40 :: Int32)))          pure ()  @@ -1077,7 +1077,7 @@                                           , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6")                                           , (ExpressionFieldName (QualifiedField "t0" "created"), Just "res7") ]          selectFrom a @?= Just (FromTable (TableNamed (TableName Nothing "employees")) (Just ("t0", Nothing)))-         selectWhere a @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (40 :: Int))))+         selectWhere a @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (40 :: Int32))))          selectGrouping a @?= Nothing          selectHaving a @?= Nothing @@ -1090,7 +1090,7 @@                                           , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6")                                           , (ExpressionFieldName (QualifiedField "t0" "created"), Just "res7") ]          selectFrom b @?= Just (FromTable (TableNamed (TableName Nothing "employees")) (Just ("t0", Nothing)))-         selectWhere b @?= Just (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (50 :: Int))))+         selectWhere b @?= Just (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (50 :: Int32))))          selectGrouping b @?= Nothing          selectHaving b @?= Nothing @@ -1110,7 +1110,7 @@              role <- all_ (_roles employeeDbSettings)              guard_ (not_ (exists_ (do dept <- all_ (_departments employeeDbSettings)                                        guard_ (_departmentName dept ==. _roleName role)-                                       pure (as_ @Int 1))))+                                       pure (as_ @Int32 1))))              pure role           let existsQuery = Select@@ -1118,7 +1118,7 @@                          , selectOrdering = []                          , selectTable = SelectTable                                        { selectQuantifier = Nothing-                                       , selectProjection = ProjExprs [ (ExpressionValue (Value (1 :: Int)), Just "res0") ]+                                       , selectProjection = ProjExprs [ (ExpressionValue (Value (1 :: Int32)), Just "res0") ]                                        , selectGrouping = Nothing                                        , selectHaving = Nothing                                        , selectWhere = Just joinExpr@@ -1143,7 +1143,7 @@                          (\employee -> _employeeFirstName employee ==. "Joe")       updateTable @?= (TableName Nothing "employees")-     updateFields @?= [ (UnqualifiedField "age", ExpressionBinOp "+" (ExpressionFieldName (UnqualifiedField "age")) (ExpressionValue (Value (1 :: Int)))) ]+     updateFields @?= [ (UnqualifiedField "age", ExpressionBinOp "+" (ExpressionFieldName (UnqualifiedField "age")) (ExpressionValue (Value (1 :: Int32)))) ]      updateWhere @?= Just (ExpressionCompOp "==" Nothing (ExpressionFieldName (UnqualifiedField "first_name")) (ExpressionValue (Value ("Joe" :: String))))  updateNullable :: TestTree

@@ -16,11 +16,9 @@ import           Database.Beam import           Database.Beam.Schema.Tables import           Database.Beam.Backend-import           Database.Beam.Backend.SQL.AST +import           Data.Int import           Data.List.NonEmpty ( NonEmpty((:|)) )-import           Data.Monoid-import           Data.Proxy import           Data.Text (Text) import qualified Data.Text as T import           Data.Time.Clock (UTCTime)@@ -52,7 +50,7 @@   , _employeeLastName  :: Columnar f Text   , _employeePhoneNumber :: Columnar f Text -  , _employeeAge       :: Columnar f Int+  , _employeeAge       :: Columnar f Int32   , _employeeSalary    :: Columnar f Double    , _employeeHireDate  :: Columnar f UTCTime@@ -117,9 +115,6 @@ deriving instance Show (TableSettings (PrimaryKey RoleT)) deriving instance Eq (TableSettings (PrimaryKey RoleT)) -roleTableSchema :: TableSettings RoleT-roleTableSchema = defTblFieldSettings- -- * Ensure that fields of a nullable primary key are given the proper Maybe type  data DepartmentT f@@ -135,9 +130,6 @@ deriving instance Show (TableSettings DepartmentT) deriving instance Eq (TableSettings DepartmentT) -departmentTableSchema :: TableSettings DepartmentT-departmentTableSchema = defTblFieldSettings- -- nullableForeignKeysGivenMaybeType :: TestTree -- nullableForeignKeysGivenMaybeType = --   testCase "Nullable foreign keys are given maybe type" $@@ -155,7 +147,7 @@   , funny_first_name :: Columnar f Text   , _funny_lastName :: Columnar f Text   , _funny_middle_Name :: Columnar f Text-  , ___ :: Columnar f Int }+  , ___ :: Columnar f Int32 }   deriving Generic instance Beamable FunnyT instance Table FunnyT where@@ -227,7 +219,6 @@ -- `ADepartmentVehiculeT` and `BDepartmentVehiculeT` are equivalent, but one was using params while -- the other had its sub-beams fixed. -type ADepartmentVehicule   = ADepartmentVehiculeT Identity type ADepartmentVehiculeT  = DepartamentRelatedT VehiculeInformationT VehiculeT data DepartamentRelatedT metaInfo prop f = DepartamentProperty       { _aDepartament  :: PrimaryKey DepartmentT f@@ -235,7 +226,6 @@       , _aMetaInfo     :: metaInfo (Nullable f)       } deriving Generic -type BDepartmentVehicule    = BDepartmentVehiculeT Identity data BDepartmentVehiculeT f = BDepartmentVehicule       { _bDepartament  :: PrimaryKey DepartmentT f       , _bRelatesTo    :: VehiculeT f@@ -258,7 +248,7 @@ data VehiculeT f = VehiculeT       { _vehiculeId     :: C f Text       , _vehiculeType   :: C f Text-      , _numberOfWheels :: C f Int+      , _numberOfWheels :: C f Int32       } deriving Generic  instance Beamable VehiculeT@@ -323,7 +313,7 @@                                                 let defName = defaultFieldName field                                                 in case T.stripPrefix "funny" defName of                                                   Nothing -> defName-                                                  Just fieldNm -> "pfx_" <> defName)+                                                  Just _ -> "pfx_" <> defName)  -- employeeDbSettingsModified :: DatabaseSettings EmployeeDb -- employeeDbSettingsModified =