packages feed

beam-core 0.10.5.0 → 0.11.1.0

raw patch · 17 files changed

Files

ChangeLog.md view
@@ -1,3 +1,41 @@+# 0.11.1.0++## New features++* Added a cross-backend abstraction for the `COPY` statement in+  `Database.Beam.Backend.SQL.BeamExtensions`:+  * file-mode `COPY ... TO 'file'` / `COPY ... FROM 'file'`. Defines+    `MonadBeamCopyTo` / `MonadBeamCopyFrom`, and the user-facing+    `copyTableTo` / `copySelectTo` / `copyTableFrom` builders.+  * streaming `COPY ... TO STDOUT` / `COPY ... FROM STDIN`. Mirrors the file-mode+    API: `MonadBeamCopyToStream` / `MonadBeamCopyFromStream`,+     and the `copyTableToStream` / `copySelectToStream` / `copyTableFromStream` builders.++## Bug fixes++* Fixed an issue where a window function applied over the result of `nub_` (or+  the Postgres-specific `pgNubBy_`) would emit `DISTINCT` and the window+  expression in the same `SELECT`, causing the window to evaluate against the+  pre-deduplicated rows. The inner select is now materialised as a subquery+  whenever it carries `DISTINCT`, `GROUP BY`, or `HAVING` (#756).++## Dependencies++* Removed dependency on `ghc-prim`.++# 0.11.0.0++## New features++* Add projection methods to `MonadBeamInsertReturning`/`MonadBeamUpdateReturning`/`MonadBeamDeleteReturning` (#801).+* Made `genericSerial` be generic over `Integral` rathern than only `Int` (#534).+* Added the `week_` combinator to extract the week of a timestamp (#599).++## Bug fixes++* Changed the type of `values_` to `NonEmpty` rather than a list, preventing runtime exceptions (#742).+* Fixed an issue where `lead1_`, `lag1_`, `lead_`, and `lag_` did not have the appropriate type, leading to runtime exceptions (#745).+ # 0.10.5.0  ## Updated dependencies@@ -18,6 +56,7 @@ * Added a `Generic` instance to `SqlNull`, `SqlBitString`, and `SqlSerial` (#736). * Added a note to `default_` to specify that it has more restrictions than its type may indicate (#744). * Added `limitMaybe_` and `offsetMaybe_` (#633).+  ## Updated dependencies
Database/Beam/Backend/SQL/AST.hs view
@@ -156,6 +156,7 @@    | ExtractFieldDateTimeYear   | ExtractFieldDateTimeMonth+  | ExtractFieldDateTimeWeek   | ExtractFieldDateTimeDay   | ExtractFieldDateTimeHour   | ExtractFieldDateTimeMinute@@ -291,6 +292,7 @@   minutesField = ExtractFieldDateTimeMinute   hourField = ExtractFieldDateTimeHour   dayField = ExtractFieldDateTimeDay+  weekField = ExtractFieldDateTimeWeek   monthField = ExtractFieldDateTimeMonth   yearField = ExtractFieldDateTimeYear
Database/Beam/Backend/SQL/BeamExtensions.hs view
@@ -9,10 +9,18 @@ -- emulated on others. module Database.Beam.Backend.SQL.BeamExtensions   ( MonadBeamInsertReturning(..)+  , runInsertReturningList   , MonadBeamUpdateReturning(..)+  , runUpdateReturningList   , MonadBeamDeleteReturning(..)+  , runDeleteReturningList   , BeamHasInsertOnConflict(..) +  -- * Support for copying to external files+  , module Database.Beam.Backend.SQL.BeamExtensions.Copy.File+  -- * Support for streaming copy+  , module Database.Beam.Backend.SQL.BeamExtensions.Copy.Stream+   , SqlSerial(..)   , onConflictUpdateInstead   , onConflictUpdateAll@@ -38,111 +46,166 @@ import           Data.Kind (Type) import           Data.Proxy import           Data.Semigroup+import           Database.Beam.Backend.SQL.BeamExtensions.Copy.File hiding (projection) -- internal function+import           Database.Beam.Backend.SQL.BeamExtensions.Copy.Stream  --import GHC.Generics --- | 'MonadBeam's that support returning the newly created rows of an @INSERT@ statement.---   Useful for discovering the real value of a defaulted value.+-- | 'MonadBeam's that support returning data from the newly created rows of an+--   @INSERT@ statement. Useful for discovering the real value of a defaulted+--   field (such as a serial primary key). class MonadBeam be m =>   MonadBeamInsertReturning be m | m -> be where-  runInsertReturningList+  -- | Execute an @INSERT@ statement and return a list of values projected from+  --   the inserted rows. The projection function selects which columns are+  --   returned: pass 'id' to return the full row, or supply a custom+  --   projection to return a subset.+  runInsertReturningListWith     :: ( Beamable table-       , Projectible be (table (QExpr be ()))-       , FromBackendRow be (table Identity) )+       , Projectible be a+       , FromBackendRow be (QExprToIdentity a) )     => SqlInsert be table-    -> m [table Identity]+    -> (table (QExpr be ()) -> a)+    -> m [QExprToIdentity a] +-- | Execute an @INSERT@ statement and return the inserted rows in full.+--   A convenience around 'runInsertReturningListWith' that uses 'id' as the+--   projection.+runInsertReturningList+  :: ( MonadBeamInsertReturning be m+     , Beamable table+     , Projectible be (table (QExpr be ()))+     , FromBackendRow be (table Identity) )+  => SqlInsert be table+  -> m [table Identity]+runInsertReturningList sql = runInsertReturningListWith sql id+ instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ExceptT e m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ContT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ReaderT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Lazy.StateT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Strict.StateT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance (MonadBeamInsertReturning be m, Monoid r)     => MonadBeamInsertReturning be (Lazy.WriterT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance (MonadBeamInsertReturning be m, Monoid r)     => MonadBeamInsertReturning be (Strict.WriterT r m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance (MonadBeamInsertReturning be m, Monoid w)     => MonadBeamInsertReturning be (Lazy.RWST r w s m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj instance (MonadBeamInsertReturning be m, Monoid w)     => MonadBeamInsertReturning be (Strict.RWST r w s m) where-    runInsertReturningList = lift . runInsertReturningList+    runInsertReturningListWith sql proj = lift $ runInsertReturningListWith sql proj --- | 'MonadBeam's that support returning the updated rows of an @UPDATE@ statement.---   Useful for discovering the new values of the updated rows.+-- | 'MonadBeam's that support returning data from the updated rows of an+--   @UPDATE@ statement. Useful for observing the post-update values of the+--   affected rows. class MonadBeam be m =>   MonadBeamUpdateReturning be m | m -> be where-  runUpdateReturningList+  -- | Execute an @UPDATE@ statement and return a list of values projected from+  --   the updated rows. The projection function selects which columns are+  --   returned: pass 'id' to return the full row, or supply a custom+  --   projection to return a subset.+  runUpdateReturningListWith     :: ( Beamable table-       , Projectible be (table (QExpr be ()))-       , FromBackendRow be (table Identity) )+       , Projectible be a+       , FromBackendRow be (QExprToIdentity a) )     => SqlUpdate be table-    -> m [table Identity]+    -> (table (QExpr be ()) -> a)+    -> m [QExprToIdentity a] +-- | Execute an @UPDATE@ statement and return the updated rows in full.+--   A convenience around 'runUpdateReturningListWith' that uses 'id' as the+--   projection.+runUpdateReturningList+  :: ( MonadBeamUpdateReturning be m+     , Beamable table+     , Projectible be (table (QExpr be ()))+     , FromBackendRow be (table Identity) )+  => SqlUpdate be table+  -> m [table Identity]+runUpdateReturningList sql = runUpdateReturningListWith sql id+ instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ExceptT e m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ContT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ReaderT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Lazy.StateT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Strict.StateT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance (MonadBeamUpdateReturning be m, Monoid r)     => MonadBeamUpdateReturning be (Lazy.WriterT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance (MonadBeamUpdateReturning be m, Monoid r)     => MonadBeamUpdateReturning be (Strict.WriterT r m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance (MonadBeamUpdateReturning be m, Monoid w)     => MonadBeamUpdateReturning be (Lazy.RWST r w s m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj instance (MonadBeamUpdateReturning be m, Monoid w)     => MonadBeamUpdateReturning be (Strict.RWST r w s m) where-    runUpdateReturningList = lift . runUpdateReturningList+    runUpdateReturningListWith sql proj = lift $ runUpdateReturningListWith sql proj --- | 'MonadBeam's that suppert returning rows that will be deleted by the given--- @DELETE@ statement. Useful for deallocating resources based on the value of--- deleted rows.+-- | 'MonadBeam's that support returning data from rows that will be deleted by+--   the given @DELETE@ statement. Useful for deallocating resources based on+--   the value of deleted rows. class MonadBeam be m =>   MonadBeamDeleteReturning be m | m -> be where-  runDeleteReturningList+  -- | Execute a @DELETE@ statement and return a list of values projected from+  --   the deleted rows. The projection function selects which columns are+  --   returned: pass 'id' to return the full row, or supply a custom+  --   projection to return a subset.+  runDeleteReturningListWith     :: ( Beamable table-       , Projectible be (table (QExpr be ()))-       , FromBackendRow be (table Identity) )+       , Projectible be a+       , FromBackendRow be (QExprToIdentity a) )     => SqlDelete be table-    -> m [table Identity]+    -> (table (QExpr be ()) -> a)+    -> m [QExprToIdentity a] +-- | Execute a @DELETE@ statement and return the deleted rows in full.+--   A convenience around 'runDeleteReturningListWith' that uses 'id' as the+--   projection.+runDeleteReturningList+  :: ( MonadBeamDeleteReturning be m+     , Beamable table+     , Projectible be (table (QExpr be ()))+     , FromBackendRow be (table Identity) )+  => SqlDelete be table+  -> m [table Identity]+runDeleteReturningList sql = runDeleteReturningListWith sql id+ instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ExceptT e m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ContT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ReaderT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Lazy.StateT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Strict.StateT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance (MonadBeamDeleteReturning be m, Monoid r)     => MonadBeamDeleteReturning be (Lazy.WriterT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance (MonadBeamDeleteReturning be m, Monoid r)     => MonadBeamDeleteReturning be (Strict.WriterT r m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance (MonadBeamDeleteReturning be m, Monoid w)     => MonadBeamDeleteReturning be (Lazy.RWST r w s m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj instance (MonadBeamDeleteReturning be m, Monoid w)     => MonadBeamDeleteReturning be (Strict.RWST r w s m) where-    runDeleteReturningList = lift . runDeleteReturningList+    runDeleteReturningListWith sql proj = lift $ runDeleteReturningListWith sql proj  class BeamSqlBackend be => BeamHasInsertOnConflict be where   -- | Specifies the kind of constraint that must be violated for the action to occur
+ Database/Beam/Backend/SQL/BeamExtensions/Copy/File.hs view
@@ -0,0 +1,320 @@+{-# LANGUAGE UndecidableInstances #-}++-- | File-mode @COPY@: the data lives on the database server's filesystem.+--+-- For the variant that streams data through the client connection instead, see+-- "Database.Beam.Backend.SQL.BeamExtensions.Copy.Stream".+module Database.Beam.Backend.SQL.BeamExtensions.Copy.File+  ( -- * Building a COPY statement+    copyTableTo,+    copySelectTo,+    SqlCopyTo (..),+    copyTableFrom,+    SqlCopyFrom (..),++    -- * Source-syntax classes (shared with streaming COPY)+    IsSqlCopyToSourceSyntax (..),+    IsSqlCopyFromSourceSyntax (..),++    -- * File-mode statement-level syntax classes+    IsSqlCopyToSyntax (..),+    IsSqlCopyFromSyntax (..),+    BeamSqlBackendCopyToSyntax,+    BeamSqlBackendCopyFromSyntax,++    -- * Runner classes+    MonadBeamCopyTo (..),+    MonadBeamCopyFrom (..),++    -- * Internal — exposed for use by sibling modules+    projection,+  )+where++import Control.Monad.Cont (ContT)+import Control.Monad.Except (ExceptT)+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.RWS.Strict as Strict+import Control.Monad.Reader (ReaderT)+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict+import Control.Monad.Trans (lift)+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.Writer.Strict as Strict+import Data.Data (Proxy (..))+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty, nonEmpty)+import Data.Text (Text)+import Database.Beam.Backend.SQL (BeamSqlBackendSelectSyntax, MonadBeam (..))+import Database.Beam.Query (QField, SqlSelect (..))+import Database.Beam.Query.Internal (AnyType, ProjectibleWithPredicate, QField (..), project')+import Database.Beam.Schema (TableEntity)+import Database.Beam.Schema.Tables+  ( Beamable,+    Columnar' (..),+    DatabaseEntity (..),+    DatabaseEntityDescriptor (DatabaseTable, dbTableSettings),+    IsDatabaseEntity (dbEntityName, dbEntitySchema),+    changeBeamRep,+    fieldName,+  )+import Lens.Micro ((^.))++-- | This class allows to express the source of a `COPY ... TO` statement.+-- The options are either from a table (with a possible projection),+-- or from the result of a select query.+--+-- Reused by both file-mode and streaming COPY: the source shape (a table or+-- a @SELECT@) is the same regardless of where the data ends up.+class IsSqlCopyToSourceSyntax syntax where+  -- | Expected to be equal to `BeamSqlBackendSelectSyntax be`+  type SqlCopyToSourceSelectSyntax syntax :: Type++  -- Copy an entire table, perhaps with some column projections+  copyTableToSyntax ::+    Maybe Text -> -- schema (Nothing = default search path)+    Text -> -- table name+    Maybe (NonEmpty Text) -> -- column list; `Nothing` means "all columns"+    syntax++  -- Copy the result of a select statement+  copySelectToSyntax ::+    SqlCopyToSourceSelectSyntax syntax ->+    syntax++-- | This class allows to express the source of a `COPY ... FROM` statement.+-- Reused by both file-mode and streaming COPY.+class IsSqlCopyFromSourceSyntax syntax where+  -- Copy data into a table, perhaps with some column projections+  copyTableFromSyntax ::+    Maybe Text -> -- schema (Nothing = default search path)+    Text -> -- table name+    Maybe (NonEmpty Text) -> -- column list; `Nothing` means "all columns"+    syntax++-- | Statement-level syntax for backends that support @COPY ... TO@ file.+class (IsSqlCopyToSourceSyntax (SqlCopyToSourceSyntax cmd)) => IsSqlCopyToSyntax cmd where+  -- | The syntax for the source of the copy. For example, in Postgres,+  --  this can be either a table (and optional projection), or a select statement.+  type SqlCopyToSourceSyntax cmd :: Type++  -- | All backend-specific options which determine HOW the copy is performed,+  --  including the destination of the data (e.g. a filepath).+  type SqlCopyToParams cmd :: Type++  -- | Combine a source and a parameters value into a complete+  -- @COPY ... TO ...@ statement.+  copyToStmt ::+    SqlCopyToSourceSyntax cmd ->+    SqlCopyToParams cmd ->+    cmd++-- | Statement-level syntax for backends that support file-mode @COPY ... FROM@ file.+--+-- Symmetric to 'IsSqlCopyToSyntax', but the data flows in the opposite+-- direction: the params value supplies the source path and any+-- format-specific options.+class (IsSqlCopyFromSourceSyntax (SqlCopyFromSourceSyntax cmd)) => IsSqlCopyFromSyntax cmd where+  -- | The syntax for the destination table of the copy.+  type SqlCopyFromSourceSyntax cmd :: Type++  -- | All backend-specific options which determine HOW the copy is performed,+  --  including the source of the data (e.g. a filepath).+  type SqlCopyFromParams cmd :: Type++  -- | Combine a destination and a parameters value into a complete+  -- @COPY ... FROM ...@ statement.+  copyFromStmt ::+    SqlCopyFromSourceSyntax cmd ->+    SqlCopyFromParams cmd ->+    cmd++-- | Type-family selector for the backend's file-mode @COPY ... TO@ syntax.+-- A backend instance binds this to the concrete syntax type that implements+-- 'IsSqlCopyToSyntax'.+type family BeamSqlBackendCopyToSyntax be :: Type++-- | Type-family selector for the backend's file-mode @COPY ... FROM@ syntax.+-- See 'BeamSqlBackendCopyToSyntax'.+type family BeamSqlBackendCopyFromSyntax be :: Type++-- | A built file-mode @COPY ... TO@ statement, ready to be executed by+-- 'runCopyTo'. Construct via 'copyTableTo' or 'copySelectTo'; the @table@+-- and @proj@ phantom parameters track which table the statement applies to+-- and which columns it projects.+data SqlCopyTo be a+  = SqlCopyTo !(BeamSqlBackendCopyToSyntax be)+  | -- | A projection covering zero columns. 'runCopyTo' should treat this as a+    --    no-op rather than emit an empty @COPY tbl () TO ...@ statement.+    SqlCopyToNoColumns++-- | A built file-mode @COPY ... FROM@ statement, ready to be executed by+-- 'runCopyFrom'. Construct via 'copyTableFrom'.+data SqlCopyFrom be a+  = SqlCopyFrom !(BeamSqlBackendCopyFromSyntax be)+  | -- | A projection covering zero columns. 'runCopyFrom' should treat this as+    --    a no-op rather than emit an empty @COPY tbl () FROM ...@ statement.+    SqlCopyFromNoColumns++-- | Express the copy from a table, to a destination (typically a file).+--+-- To copy the result of a @SELECT@ query instead, see `copySelectTo`.+--+-- @since 0.11.1.0+copyTableTo ::+  ( IsSqlCopyToSyntax (BeamSqlBackendCopyToSyntax be),+    ProjectibleWithPredicate AnyType () Text proj+  ) =>+  DatabaseEntity be db (TableEntity table) ->+  -- | Projection from table to columns. If you want+  --  to copy the entire table, use 'id'.+  (table (QField s) -> proj) ->+  -- | Backend-specific options. The output is also determined by this value+  SqlCopyToParams (BeamSqlBackendCopyToSyntax be) ->+  SqlCopyTo be proj+copyTableTo (DatabaseEntity dt@(DatabaseTable {})) mkProj options =+  case nonEmpty (projection dt mkProj) of+    Nothing -> SqlCopyToNoColumns+    Just cols ->+      let source = copyTableToSyntax (dt ^. dbEntitySchema) (dt ^. dbEntityName) (Just cols)+       in SqlCopyTo+            (copyToStmt source options)++-- | Express the copy from the result of a @SELECT@ statement to a destination+-- (typically a file). Use this when the source rows are produced by a query+-- rather than read directly from a table.+--+-- To copy a table, or a subset of columns, see `copyTableTo`.+--+-- @since 0.11.1.0+copySelectTo ::+  ( IsSqlCopyToSyntax (BeamSqlBackendCopyToSyntax be),+    SqlCopyToSourceSelectSyntax (SqlCopyToSourceSyntax (BeamSqlBackendCopyToSyntax be))+      ~ BeamSqlBackendSelectSyntax be+  ) =>+  SqlSelect be a ->+  -- | Backend-specific options. The format is pinned by this value+  SqlCopyToParams (BeamSqlBackendCopyToSyntax be) ->+  SqlCopyTo be a+copySelectTo (SqlSelect selectSyntax) options =+  let source = copySelectToSyntax selectSyntax+   in SqlCopyTo (copyToStmt source options)++-- | Express the copy to a table, from an external source (typically a file).+--+-- @since 0.11.1.0+copyTableFrom ::+  ( IsSqlCopyFromSyntax (BeamSqlBackendCopyFromSyntax be),+    ProjectibleWithPredicate AnyType () Text proj+  ) =>+  DatabaseEntity be db (TableEntity table) ->+  -- | Projection from table to columns. If you want+  --  to copy into the entire table, use 'id'.+  (table (QField s) -> proj) ->+  -- | Backend-specific options. The format is pinned by this value+  SqlCopyFromParams (BeamSqlBackendCopyFromSyntax be) ->+  SqlCopyFrom be proj+copyTableFrom (DatabaseEntity dt@(DatabaseTable {})) mkProj options =+  case nonEmpty (projection dt mkProj) of+    Nothing -> SqlCopyFromNoColumns+    Just cols ->+      let source = copyTableFromSyntax (dt ^. dbEntitySchema) (dt ^. dbEntityName) (Just cols)+       in SqlCopyFrom+            (copyFromStmt source options)++-- | Walk a projection and collect the names of the columns it touches.+--+-- This is the building block 'copyTableTo' / 'copyTableFrom' (and their+-- streaming counterparts) use to derive the column list for the emitted+-- @COPY@ statement. Exposed here so that the streaming submodule can reuse+-- the same logic without duplication.+projection ::+  (ProjectibleWithPredicate AnyType () Text proj, Beamable table) =>+  DatabaseEntityDescriptor be (TableEntity table) ->+  (table (QField s) -> proj) ->+  [Text]+projection dt mkProj =+  Strict.execWriter+    ( project'+        (Proxy @AnyType)+        (Proxy @((), Text))+        (\_ _ f -> Strict.tell [f] >> pure f)+        (mkProj tblFields)+    )+  where+    tblFields =+      changeBeamRep+        (\(Columnar' fd) -> Columnar' (QField False (dt ^. dbEntityName) (fd ^. fieldName)))+        (dbTableSettings dt)++-- | 'MonadBeam's that support copying data out of a database, to some other location.+--+-- See 'MonadBeamCopyFrom' for the inverse operation.+--+-- @since 0.11.1.0+class (MonadBeam be m) => MonadBeamCopyTo be m | m -> be where+  -- | Execute a built @COPY ... TO@ file statement.+  runCopyTo :: SqlCopyTo be res -> m ()++instance (MonadBeamCopyTo be m) => MonadBeamCopyTo be (ExceptT e m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m) => MonadBeamCopyTo be (ContT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m) => MonadBeamCopyTo be (ReaderT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m) => MonadBeamCopyTo be (Lazy.StateT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m) => MonadBeamCopyTo be (Strict.StateT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m, Monoid r) => MonadBeamCopyTo be (Lazy.WriterT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m, Monoid r) => MonadBeamCopyTo be (Strict.WriterT r m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m, Monoid w) => MonadBeamCopyTo be (Lazy.RWST r w s m) where+  runCopyTo = lift . runCopyTo++instance (MonadBeamCopyTo be m, Monoid w) => MonadBeamCopyTo be (Strict.RWST r w s m) where+  runCopyTo = lift . runCopyTo++-- | 'MonadBeam's that support copying data into database, from other location.+--+-- See 'MonadBeamCopyTo' for the inverse operation.+--+-- @since 0.11.1.0+class (MonadBeam be m) => MonadBeamCopyFrom be m | m -> be where+  -- | Execute a built @COPY ... FROM@ file statement.+  runCopyFrom :: SqlCopyFrom be proj -> m ()++instance (MonadBeamCopyFrom be m) => MonadBeamCopyFrom be (ExceptT e m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m) => MonadBeamCopyFrom be (ContT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m) => MonadBeamCopyFrom be (ReaderT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m) => MonadBeamCopyFrom be (Lazy.StateT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m) => MonadBeamCopyFrom be (Strict.StateT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m, Monoid r) => MonadBeamCopyFrom be (Lazy.WriterT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m, Monoid r) => MonadBeamCopyFrom be (Strict.WriterT r m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m, Monoid w) => MonadBeamCopyFrom be (Lazy.RWST r w s m) where+  runCopyFrom = lift . runCopyFrom++instance (MonadBeamCopyFrom be m, Monoid w) => MonadBeamCopyFrom be (Strict.RWST r w s m) where+  runCopyFrom = lift . runCopyFrom
+ Database/Beam/Backend/SQL/BeamExtensions/Copy/Stream.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE UndecidableInstances #-}++-- | Streaming-mode @COPY@: the data flows through the client connection+-- rather than to or from a file on the database server.+--+-- For the file-mode variant, see+-- "Database.Beam.Backend.SQL.BeamExtensions.Copy.File".+module Database.Beam.Backend.SQL.BeamExtensions.Copy.Stream+  ( -- * Building a streaming COPY statement+    copyTableToStream,+    copySelectToStream,+    SqlCopyToStream (..),+    copyTableFromStream,+    SqlCopyFromStream (..),++    -- * Streaming statement-level syntax classes+    IsSqlCopyToStreamSyntax (..),+    IsSqlCopyFromStreamSyntax (..),+    BeamSqlBackendCopyToStreamSyntax,+    BeamSqlBackendCopyFromStreamSyntax,++    -- * Runner classes+    MonadBeamCopyToStream (..),+    MonadBeamCopyFromStream (..),+  )+where++import Control.Monad.Cont (ContT)+import Control.Monad.Except (ExceptT)+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.RWS.Strict as Strict+import Control.Monad.Reader (ReaderT)+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict+import Control.Monad.Trans (lift)+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.Writer.Strict as Strict+import Data.ByteString (ByteString)+import Data.Kind (Type)+import Data.List.NonEmpty (nonEmpty)+import Data.Text (Text)+import Database.Beam.Backend.SQL (BeamSqlBackendSelectSyntax, MonadBeam)+import Database.Beam.Backend.SQL.BeamExtensions.Copy.File+  ( IsSqlCopyFromSourceSyntax (..),+    IsSqlCopyToSourceSyntax (..),+    projection,+  )+import Database.Beam.Query (QField, SqlSelect (..))+import Database.Beam.Query.Internal (AnyType, ProjectibleWithPredicate)+import Database.Beam.Schema (TableEntity)+import Database.Beam.Schema.Tables+  ( DatabaseEntity (..),+    DatabaseEntityDescriptor (DatabaseTable),+    IsDatabaseEntity (dbEntityName, dbEntitySchema),+  )+import Lens.Micro ((^.))++-- | Statement-level syntax for backends that support streaming+-- @COPY ... TO@ (data leaving the database through the client connection).+--+-- Mirrors 'Database.Beam.Backend.SQL.BeamExtensions.Copy.File.IsSqlCopyToSyntax',+-- but the params value carries only format options — no destination path,+-- since chunks travel through the wire.+class (IsSqlCopyToSourceSyntax (SqlCopyToStreamSourceSyntax cmd)) => IsSqlCopyToStreamSyntax cmd where+  -- | The syntax for the source of the streaming copy. As with file-mode+  --  COPY, this can be a table (perhaps with a projection) or a @SELECT@+  --  query.+  type SqlCopyToStreamSourceSyntax cmd :: Type++  -- | All backend-specific options which determine HOW the streaming copy+  --  is performed (format, delimiter, etc.). Unlike the file-mode params,+  --  there is no destination — chunks flow through the connection.+  type SqlCopyToStreamParams cmd :: Type++  -- | Combine a source and a parameters value into a complete+  -- streaming @COPY ... TO@ stream statement.+  copyToStreamStmt ::+    SqlCopyToStreamSourceSyntax cmd ->+    SqlCopyToStreamParams cmd ->+    cmd++-- | Statement-level syntax for backends that support streaming+-- @COPY ... FROM@ (data entering the database through the client connection).+--+-- Mirrors 'Database.Beam.Backend.SQL.BeamExtensions.Copy.File.IsSqlCopyFromSyntax'.+class (IsSqlCopyFromSourceSyntax (SqlCopyFromStreamSourceSyntax cmd)) => IsSqlCopyFromStreamSyntax cmd where+  -- | The syntax for the destination table of the streaming copy.+  type SqlCopyFromStreamSourceSyntax cmd :: Type++  -- | All backend-specific options which determine HOW the streaming copy+  --  is performed. Unlike the file-mode params, there is no source path —+  --  chunks flow through the connection.+  type SqlCopyFromStreamParams cmd :: Type++  -- | Combine a destination and a parameters value into a complete+  -- streaming @COPY ... FROM@ stream statement.+  copyFromStreamStmt ::+    SqlCopyFromStreamSourceSyntax cmd ->+    SqlCopyFromStreamParams cmd ->+    cmd++-- | Type-family selector for the backend's streaming @COPY ... TO@ syntax.+-- A backend instance binds this to the concrete syntax type that+-- implements 'IsSqlCopyToStreamSyntax'.+type family BeamSqlBackendCopyToStreamSyntax be :: Type++-- | Type-family selector for the backend's streaming @COPY ... FROM@ syntax.+-- See 'BeamSqlBackendCopyToStreamSyntax'.+type family BeamSqlBackendCopyFromStreamSyntax be :: Type++-- | A built streaming-mode @COPY ... TO@ statement, ready to be executed by+-- 'runCopyToStream'.+data SqlCopyToStream be a+  = SqlCopyToStream !(BeamSqlBackendCopyToStreamSyntax be)+  | -- | A projection covering zero columns. 'runCopyToStream' should treat+    --    this as a no-op (it must still call the sink zero times) rather+    --    than emit an empty @COPY tbl () TO STDOUT@ statement.+    SqlCopyToStreamNoColumns++-- | A built streaming-mode @COPY ... FROM@ statement, ready to be executed+-- by 'runCopyFromStream'.+data SqlCopyFromStream be a+  = SqlCopyFromStream !(BeamSqlBackendCopyFromStreamSyntax be)+  | -- | A projection covering zero columns. 'runCopyFromStream' should+    --    treat this as a no-op (it should not pull from the source) rather+    --    than emit an empty @COPY tbl () FROM STDIN@ statement.+    SqlCopyFromStreamNoColumns++-- | Express a streaming copy from a table, the data flowing through the+-- client connection rather than to a server-side file.+--+-- To stream the result of a @SELECT@ query instead, see 'copySelectToStream'.+--+-- @since 0.11.1.0+copyTableToStream ::+  ( IsSqlCopyToStreamSyntax (BeamSqlBackendCopyToStreamSyntax be),+    ProjectibleWithPredicate AnyType () Text proj+  ) =>+  DatabaseEntity be db (TableEntity table) ->+  -- | Projection from table to columns. If you want+  --  to copy the entire table, use 'id'.+  (table (QField s) -> proj) ->+  -- | Backend-specific options.+  SqlCopyToStreamParams (BeamSqlBackendCopyToStreamSyntax be) ->+  SqlCopyToStream be proj+copyTableToStream (DatabaseEntity dt@(DatabaseTable {})) mkProj options =+  case nonEmpty (projection dt mkProj) of+    Nothing -> SqlCopyToStreamNoColumns+    Just cols ->+      let source = copyTableToSyntax (dt ^. dbEntitySchema) (dt ^. dbEntityName) (Just cols)+       in SqlCopyToStream+            (copyToStreamStmt source options)++-- | Express a streaming copy from the result of a @SELECT@ statement.+--+-- To stream a table, or a subset of columns, see 'copyTableToStream'.+--+-- @since 0.11.1.0+copySelectToStream ::+  ( IsSqlCopyToStreamSyntax (BeamSqlBackendCopyToStreamSyntax be),+    SqlCopyToSourceSelectSyntax (SqlCopyToStreamSourceSyntax (BeamSqlBackendCopyToStreamSyntax be))+      ~ BeamSqlBackendSelectSyntax be+  ) =>+  SqlSelect be a ->+  SqlCopyToStreamParams (BeamSqlBackendCopyToStreamSyntax be) ->+  SqlCopyToStream be a+copySelectToStream (SqlSelect selectSyntax) options =+  let source = copySelectToSyntax selectSyntax+   in SqlCopyToStream (copyToStreamStmt source options)++-- | Express a streaming copy into a table, the data flowing through the+-- client connection rather than from a server-side file.+--+-- @since 0.11.1.0+copyTableFromStream ::+  ( IsSqlCopyFromStreamSyntax (BeamSqlBackendCopyFromStreamSyntax be),+    ProjectibleWithPredicate AnyType () Text proj+  ) =>+  DatabaseEntity be db (TableEntity table) ->+  -- | Projection from which to copy columns. Other columns+  -- will have their default value inserted.+  --+  -- To copy the stream into the entire table, use 'id'.+  (table (QField s) -> proj) ->+  SqlCopyFromStreamParams (BeamSqlBackendCopyFromStreamSyntax be) ->+  SqlCopyFromStream be proj+copyTableFromStream (DatabaseEntity dt@(DatabaseTable {})) mkProj options =+  case nonEmpty (projection dt mkProj) of+    Nothing -> SqlCopyFromStreamNoColumns+    Just cols ->+      let source = copyTableFromSyntax (dt ^. dbEntitySchema) (dt ^. dbEntityName) (Just cols)+       in SqlCopyFromStream+            (copyFromStreamStmt source options)++-- | 'MonadBeam's that support streaming data out of a database through the+-- client connection (e.g. PostgreSQL's @COPY ... TO STDOUT@).+--+-- The supplied @ByteString -> IO ()@ callback is invoked once per chunk+-- received. The 'runCopyToStream' call blocks until the COPY completes; on+-- failure it raises the underlying backend's exception.+--+-- See 'MonadBeamCopyFromStream' for the inverse operation.+--+-- @since 0.11.1.0+class (MonadBeam be m) => MonadBeamCopyToStream be m | m -> be where+  -- | Execute a built streaming @COPY ... TO@ stream statement. The supplied sink+  -- is invoked from 'IO' once per chunk emitted by the server, in order;+  -- 'runCopyToStream' returns once the server signals end of stream.+  runCopyToStream ::+    SqlCopyToStream be a ->+    -- | Sink. Called once for each chunk of bytes the server emits.+    (ByteString -> IO ()) ->+    m ()++instance (MonadBeamCopyToStream be m) => MonadBeamCopyToStream be (ExceptT e m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m) => MonadBeamCopyToStream be (ContT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m) => MonadBeamCopyToStream be (ReaderT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m) => MonadBeamCopyToStream be (Lazy.StateT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m) => MonadBeamCopyToStream be (Strict.StateT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m, Monoid r) => MonadBeamCopyToStream be (Lazy.WriterT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m, Monoid r) => MonadBeamCopyToStream be (Strict.WriterT r m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m, Monoid w) => MonadBeamCopyToStream be (Lazy.RWST r w s m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++instance (MonadBeamCopyToStream be m, Monoid w) => MonadBeamCopyToStream be (Strict.RWST r w s m) where+  runCopyToStream s cb = lift (runCopyToStream s cb)++-- | 'MonadBeam's that support streaming data into a database through the+-- client connection (e.g. PostgreSQL's @COPY ... FROM STDIN@).+--+-- The supplied @IO (Maybe ByteString)@ source is pulled repeatedly until it+-- returns 'Nothing', signalling end of data. 'runCopyFromStream' blocks+-- until the COPY commits; on failure it raises the underlying backend's+-- exception.+--+-- See 'MonadBeamCopyToStream' for the inverse operation.+--+-- @since 0.11.1.0+class (MonadBeam be m) => MonadBeamCopyFromStream be m | m -> be where+  -- | Execute a built streaming @COPY ... FROM@ statement. The supplied+  -- producer is pulled from 'IO' until it returns 'Nothing'; each 'Just'+  -- chunk is forwarded to the server in order. 'runCopyFromStream' returns+  -- once the server has acknowledged the end of stream.+  runCopyFromStream ::+    SqlCopyFromStream be a ->+    -- | Source. Called repeatedly. 'Nothing' signals end of data.+    IO (Maybe ByteString) ->+    m ()++instance (MonadBeamCopyFromStream be m) => MonadBeamCopyFromStream be (ExceptT e m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m) => MonadBeamCopyFromStream be (ContT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m) => MonadBeamCopyFromStream be (ReaderT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m) => MonadBeamCopyFromStream be (Lazy.StateT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m) => MonadBeamCopyFromStream be (Strict.StateT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m, Monoid r) => MonadBeamCopyFromStream be (Lazy.WriterT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m, Monoid r) => MonadBeamCopyFromStream be (Strict.WriterT r m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m, Monoid w) => MonadBeamCopyFromStream be (Lazy.RWST r w s m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)++instance (MonadBeamCopyFromStream be m, Monoid w) => MonadBeamCopyFromStream be (Strict.RWST r w s m) where+  runCopyFromStream s producer = lift (runCopyFromStream s producer)
Database/Beam/Backend/SQL/Builder.hs view
@@ -191,6 +191,7 @@   minutesField = SqlSyntaxBuilder (byteString "MINUTE")   hourField    = SqlSyntaxBuilder (byteString "HOUR")   dayField     = SqlSyntaxBuilder (byteString "DAY")+  weekField    = SqlSyntaxBuilder (byteString "WEEK")   monthField   = SqlSyntaxBuilder (byteString "MONTH")   yearField    = SqlSyntaxBuilder (byteString "YEAR")
Database/Beam/Backend/SQL/SQL92.hs view
@@ -206,6 +206,7 @@   minutesField :: extractField   hourField :: extractField   dayField :: extractField+  weekField :: extractField   monthField :: extractField   yearField :: extractField
Database/Beam/Backend/Types.hs view
@@ -6,8 +6,8 @@   , Exposed, Nullable    ) where+import Data.Kind (Type, Constraint) -import GHC.Types  -- | Class for all Beam backends class BeamBackend be where
Database/Beam/Query/CTE.hs view
@@ -10,7 +10,7 @@  import Control.Monad.Fix import Control.Monad.Free.Church-import Control.Monad.Writer hiding ((<>))+import Control.Monad.Writer (WriterT, tell) import Control.Monad.State.Strict  import Data.Kind (Type)
Database/Beam/Query/Combinators.hs view
@@ -80,6 +80,8 @@ import Control.Monad.Free import Control.Applicative +import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe import Data.Proxy import Data.Time (LocalTime)@@ -105,16 +107,22 @@                     (tableFieldsToExpressions (dbViewSettings vw))                     (\_ -> Nothing) snd) --- | SQL @VALUES@ clause. Introduce the elements of the given list as+-- | SQL @VALUES@ clause. Introduce the elements of the given non-empty list as -- rows in a joined table. values_ :: forall be db s a          . ( Projectible be a            , BeamSqlBackend be )-        => [ a ] -> Q be db s a+        => NonEmpty a+        -> Q be db s a values_ rows =-    Q $ liftF (QAll (\tblPfx -> fromTable (tableFromValues (map (\row -> project (Proxy @be) row tblPfx) rows)) . Just . (,Just fieldNames))+    Q $ liftF (QAll (\tblPfx -> +                      fromTable +                        (tableFromValues (NonEmpty.toList (NonEmpty.map (\row -> project (Proxy @be) row tblPfx) rows))) +                        . Just +                        . (,Just fieldNames))                     (\tblNm' -> fst $ mkFieldNames (qualifiedField tblNm'))-                    (\_ -> Nothing) snd)+                    (\_ -> Nothing) snd+              )     where       fieldNames = snd $ mkFieldNames @be @a unqualifiedField
Database/Beam/Query/Extensions.hs view
@@ -47,13 +47,13 @@  lead1_, lag1_   :: (BeamSqlBackend be, BeamSqlT615Backend be)-  => QExpr be s a -> QAgg be s a+  => QExpr be s a -> QAgg be s (Maybe a) lead1_ (QExpr a) = QExpr (leadE <$> a <*> pure Nothing <*> pure Nothing) lag1_ (QExpr a) = QExpr (lagE <$> a <*> pure Nothing <*> pure Nothing)  lead_, lag_   :: (BeamSqlBackend be, BeamSqlT615Backend be, Integral n)-  => QExpr be s a -> QExpr be s n -> QAgg be s a+  => QExpr be s a -> QExpr be s n -> QAgg be s (Maybe 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)
Database/Beam/Query/Extract.hs view
@@ -7,7 +7,7 @@        -- ** SQL92 fields       hour_, minutes_, seconds_,-      year_, month_, day_,+      year_, month_, week_, day_,        HasSqlTime, HasSqlDate     ) where@@ -53,9 +53,10 @@ instance HasSqlDate UTCTime instance HasSqlDate Day -year_, month_, day_+year_, month_, week_, day_     :: ( BeamSqlBackend be, HasSqlDate tgt )     => ExtractField be tgt Double year_  = ExtractField yearField month_ = ExtractField monthField day_   = ExtractField dayField+week_  = ExtractField weekField
Database/Beam/Query/Internal.hs view
@@ -9,6 +9,7 @@  import qualified Data.DList as DList import           Data.Functor.Const+import           Data.Kind (Type, Constraint) import           Data.String import qualified Data.Text as T import           Data.Typeable@@ -20,7 +21,6 @@ import           Control.Monad.Writer  import           GHC.TypeLits-import           GHC.Types  import           Unsafe.Coerce
Database/Beam/Query/SQL92.hs view
@@ -322,7 +322,12 @@              _ -> doJoined      buildQuery tblPfx (Free (QWindowOver mkWindows mkProjection q' next)) =-        let sb = buildQuery tblPfx (fromF q')+        -- If the inner select carries DISTINCT, GROUP BY, or HAVING, those must+        -- apply to the row set *before* the window function. Emitting them in+        -- the same SELECT as the window projection inverts that order in SQL,+        -- yielding wrong results (issue #746). Materialise the inner select as+        -- a subquery in that case so the window evaluates over its output.+        let sb = forceSubqueryIfGrouping (buildQuery tblPfx (fromF q'))              x = sbProj sb             windows = mkWindows x@@ -336,6 +341,17 @@              _       ->                let (x', qb) = selectBuilderToQueryBuilder tblPfx (setSelectBuilderProjection sb projection)                in buildJoinedQuery tblPfx (next x') qb+      where+        forceSubqueryIfGrouping :: Projectible be x' => SelectBuilder be db x' -> SelectBuilder be db x'+        forceSubqueryIfGrouping sb0+          | hasGroupingClause sb0 = uncurry SelectBuilderQ $ selectBuilderToQueryBuilder tblPfx sb0+          | otherwise = sb0+          where+            hasGroupingClause :: SelectBuilder be db x' -> Bool+            hasGroupingClause (SelectBuilderGrouping _ _ grouping having distinct) =+                isJust grouping || isJust having || isJust distinct+            hasGroupingClause (SelectBuilderTopLevel _ _ _ inner _) = hasGroupingClause inner+            hasGroupingClause _ = False      buildQuery tblPfx (Free (QLimit limit q' next)) =         let sb = limitSelectBuilder limit (buildQuery tblPfx (fromF q'))
Database/Beam/Schema/Tables.hs view
@@ -79,10 +79,11 @@ import           Control.Applicative (liftA2) import           Control.Arrow (first) import           Control.Monad.Identity-import           Control.Monad.Writer hiding ((<>))+import           Control.Monad.Writer (Writer, execWriter, tell)  import           Data.Char (isUpper, toLower) import           Data.Foldable (fold)+import           Data.Kind (Type, Constraint) import qualified Data.List.NonEmpty as NE import           Data.Monoid import           Data.Proxy@@ -94,7 +95,6 @@ import qualified GHC.Generics as Generic import           GHC.Generics hiding (R, C) import           GHC.TypeLits-import           GHC.Types  import           Lens.Micro hiding (to)
beam-core.cabal view
@@ -1,5 +1,5 @@ name:                beam-core-version:             0.10.5.0+version:             0.11.1.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@@ -47,7 +47,10 @@                         Database.Beam.Backend.Internal.Compat -  other-modules:       Database.Beam.Query.Aggregate+  other-modules:       Database.Beam.Backend.SQL.BeamExtensions.Copy.File+                       Database.Beam.Backend.SQL.BeamExtensions.Copy.Stream++                       Database.Beam.Query.Aggregate                        Database.Beam.Query.Combinators                        Database.Beam.Query.Extensions                        Database.Beam.Query.Extract@@ -63,10 +66,9 @@                        bytestring   >=0.10    && <0.13,                        mtl          >=2.2.1   && <2.4,                        microlens    >=0.4     && <0.6,-                       ghc-prim     >=0.5     && <0.14,                        free         >=4.12    && <5.3,                        dlist        >=0.7.1.2 && <1.1,-                       time         >=1.6     && <1.15,+                       time         >=1.6     && <1.17,                        hashable     >=1.2.4.0 && <1.6,                        network-uri  >=2.6     && <2.7,                        containers   >=0.5     && <0.9,
test/Database/Beam/Test/SQL.hs view
@@ -31,6 +31,7 @@                   , leftJoinSingle                   , aggregates                   , orderBy+                  , innerNub                    , joinHaving @@ -127,7 +128,7 @@ simpleWhereNoFrom =   testCase "WHERE clause not dropped if there is no FROM" $ do     SqlSelect Select { selectTable = SelectTable { .. }, .. } <- pure $ selectMock simple-    +     selectGrouping @?= Nothing     selectOrdering @?= []     selectLimit @?= Nothing@@ -137,7 +138,7 @@     -- Important point: no FROM clause, yet WHERE clause should still be here     selectFrom @?= Nothing     selectWhere @?= (Just (ExpressionValue (Value False)))-  +   where     simple :: Q (MockSqlBackend Command) EmptyDb s (QExpr (MockSqlBackend Command) s Bool)     simple = do@@ -769,6 +770,61 @@          selectFrom s @?= Just (InnerJoin (FromTable (TableNamed (TableName Nothing "roles")) (Just ("t0", Nothing)))                                           (FromTable (TableFromSubSelect subselect) (Just ("t1", Nothing)))                                           Nothing)+++-- | Ensure that a SQL DISTINCT in a subquery does not propagate up (see issue #746)+innerNub :: TestTree+innerNub =+  testCase "DISTINCT clause on inner SELECT" $ do+    stmt@(SqlSelect Select{selectTable = SelectTable{..}, ..}) <- pure $ selectMock query++    selectGrouping @?= Nothing+    selectOrdering @?= []+    selectLimit @?= Nothing+    selectOffset @?= Nothing+    selectHaving @?= Nothing+    selectQuantifier @?= Nothing -- quantifier should be in the subquery+    selectFrom+      @?= Just+        ( FromTable+            ( TableFromSubSelect+                ( Select+                    { selectTable =+                        SelectTable+                          { selectQuantifier = Just SetQuantifierDistinct+                          , selectProjection = ProjExprs [(ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0")]+                          , selectFrom = Just (FromTable (TableNamed (TableName Nothing "employees")) (Just ("t0", Nothing)))+                          , selectWhere = Nothing+                          , selectGrouping = Nothing+                          , selectHaving = Nothing+                          }+                    , selectOrdering = []+                    , selectLimit = Nothing+                    , selectOffset = Nothing+                    }+                )+            )+            (Just ("t0", Nothing))+        )+    selectWhere+      @?= Just+        ( ExpressionCompOp+            "=="+            Nothing+            (ExpressionFieldName (QualifiedField "t0" "res0"))+            (ExpressionValue (Value @Text "Alice"))+        )+ where+  query :: Q (MockSqlBackend Command) EmployeeDb s (QExpr (MockSqlBackend Command) s Text)+  query = do+    name <- subQuery+    guard_ (name ==. val_ "Alice")+    pure name++  -- This sub query contains a DISTINCT clause via `nub_`+  subQuery :: Q (MockSqlBackend Command) EmployeeDb s (QExpr (MockSqlBackend Command) s Text)+  subQuery = nub_ $ _employeeFirstName <$> (all_ (_employees employeeDbSettings))+  -- | HAVING clause should not be floated out of a join