From 5c343025c117a3ffac0a0fd649a4d16e0e800539 Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:08:28 +0000 Subject: [PATCH 1/6] Remove warning --- .../Database/Beam/Postgres/Connection.hs | 8 ++++---- flake.nix | 20 +++++++++++++++++++ 2 files changed, 24 insertions(+), 4 deletions(-) create mode 100644 flake.nix diff --git a/beam-postgres/Database/Beam/Postgres/Connection.hs b/beam-postgres/Database/Beam/Postgres/Connection.hs index deb0fa4b..bb42a1c8 100644 --- a/beam-postgres/Database/Beam/Postgres/Connection.hs +++ b/beam-postgres/Database/Beam/Postgres/Connection.hs @@ -155,13 +155,13 @@ runPgRowReader conn rowIdx res fields (FromBackendRowM readRow) = Pg.ConversionFailed { Pg.errSQLType = sql , Pg.errHaskellType = hs , Pg.errMessage = msg - , Pg.errSQLField = field } -> - pure (ColumnTypeMismatch hs sql ("Conversion failed for field'" <> field <> "': " <> msg)) + , Pg.errSQLField = errField } -> + pure (ColumnTypeMismatch hs sql ("Conversion failed for field'" <> errField <> "': " <> msg)) Pg.Incompatible { Pg.errSQLType = sql , Pg.errHaskellType = hs , Pg.errMessage = msg - , Pg.errSQLField = field } -> - pure (ColumnTypeMismatch hs sql ("Incompatible field: '" <> field <> "': " <> msg)) + , Pg.errSQLField = errField } -> + pure (ColumnTypeMismatch hs sql ("Incompatible field: '" <> errField <> "': " <> msg)) Pg.UnexpectedNull {} -> pure ColumnUnexpectedNull in pure (Left (BeamRowReadError (Just (fromIntegral curCol)) err)) diff --git a/flake.nix b/flake.nix new file mode 100644 index 00000000..63ca2ac8 --- /dev/null +++ b/flake.nix @@ -0,0 +1,20 @@ +let nixhash = import ./nix/nixhash.nix; +in { + inputs.nixpkgs.url = "github:nixos/nixpkgs/${nixhash}"; + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { nixpkgs, flake-utils, self, ... }: + flake-utils.lib.forEachSystem (system: + let pkgs = import nixpkgs { inherit system; }; + beamLib = import ./nix/lib.nix { nixpkgs = pkgs; }; + beamGhc = beamLib.makeBeamGhc ghc; + in { + devShells.default = beamGhc.shellFor { + packages = beamLib.beamPackageList; + nativeBuildInputs = [ + postgresql sqlite-interactive + cabal-install + ]; + }; + }); +} From aed859bed42cb32a64fc1fc2813c45139ffb24fa Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:08:37 +0000 Subject: [PATCH 2/6] Add flake.lock --- flake.lock | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 flake.lock diff --git a/flake.lock b/flake.lock new file mode 100644 index 00000000..72fb323a --- /dev/null +++ b/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1726560853, + "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1686331006, + "narHash": "sha256-hElRDWUNG655aqF0awu+h5cmDN+I/dQcChRt2tGuGGU=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "85bcb95aa83be667e562e781e9d186c57a07d757", + "type": "github" + }, + "original": { + "owner": "nixos", + "repo": "nixpkgs", + "rev": "85bcb95aa83be667e562e781e9d186c57a07d757", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} From 223f2767e1b9f0668357647b48e1322697246aea Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:10:10 +0000 Subject: [PATCH 3/6] Implement support for inner CTEs in Postgres --- beam-core/Database/Beam/Query/Internal.hs | 7 +++- beam-postgres/Database/Beam/Postgres/Full.hs | 43 +++++++++++++++++++- flake.nix | 31 ++++++++------ 3 files changed, 67 insertions(+), 14 deletions(-) diff --git a/beam-core/Database/Beam/Query/Internal.hs b/beam-core/Database/Beam/Query/Internal.hs index 70648c19..35af1f91 100644 --- a/beam-core/Database/Beam/Query/Internal.hs +++ b/beam-core/Database/Beam/Query/Internal.hs @@ -41,9 +41,14 @@ data QF be (db :: (Type -> Type) -> Type) s next where QAll :: Projectible be r => (TablePrefix -> T.Text -> BeamSqlBackendFromSyntax be) + -- ^ build the FROM syntax using the table prefix and the table name -> (T.Text -> r) + -- ^ Given a table name, get the various Qs for all the expressions in that table -> (r -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be))) - -> ((T.Text, r) -> next) -> QF be db s next + -- ^ on clause, if any + -> ((T.Text, r) -> next) + -- ^ Generate the result from the table name and projectible result + -> QF be db s next QArbitraryJoin :: Projectible be r => QM be db (QNested s) r diff --git a/beam-postgres/Database/Beam/Postgres/Full.hs b/beam-postgres/Database/Beam/Postgres/Full.hs index 7c80a9e8..0163d799 100644 --- a/beam-postgres/Database/Beam/Postgres/Full.hs +++ b/beam-postgres/Database/Beam/Postgres/Full.hs @@ -20,6 +20,9 @@ module Database.Beam.Postgres.Full , locked_, lockAll_, withLocks_ + -- ** Inner WITH queries + , pgSelectWith + -- ** Lateral joins , lateral_ @@ -55,15 +58,18 @@ module Database.Beam.Postgres.Full ) where import Database.Beam hiding (insert, insertValues) -import Database.Beam.Query.Internal import Database.Beam.Backend.SQL import Database.Beam.Backend.SQL.BeamExtensions +import qualified Database.Beam.Query.CTE as CTE +import Database.Beam.Query.Internal import Database.Beam.Schema.Tables import Database.Beam.Postgres.Types import Database.Beam.Postgres.Syntax import Control.Monad.Free.Church +import Control.Monad.State.Strict (evalState) +import Control.Monad.Writer (runWriterT) import Data.Kind (Type) import Data.Proxy (Proxy(..)) @@ -274,6 +280,41 @@ lateral_ using mkSubquery = do (\_ -> Nothing) (rewriteThread (Proxy @s)))) +-- | The SQL standard only allows CTE expressions (WITH expressions) +-- at the top-level. Postgres allows you to embed these within a +-- subquery. +-- +-- For example, +-- +-- @ +-- SELECT a.column1, b.column2 FROM (WITH RECURSIVE ... ) a JOIN b +-- @ +-- +-- @beam-core@ offers 'selectWith' to produce a top-level 'SqlSelect' +-- but these cannot be turned into 'Q' objects for use within joins. +-- +-- The 'pgSelectWith' function is more flexible and indeed +-- 'selectWith' for @beam-postgres@ is equivalent to se +pgSelectWith :: forall db s res + . Projectible Postgres res + => With Postgres db (Q Postgres db s res) -> Q Postgres db s res +pgSelectWith (CTE.With mkQ) = + let (q, (recursiveness, ctes)) = evalState (runWriterT mkQ) 0 + fromSyntax tblPfx = + case recursiveness of + CTE.Nonrecursive -> withSyntax ctes (buildSqlQuery tblPfx q) + CTE.Recursive -> withRecursiveSyntax ctes (buildSqlQuery tblPfx q) + in Q (liftF (QAll (\tblPfx tName -> + let (_, names) = mkFieldNames @Postgres @res (qualifiedField tName) + in fromTable (PgTableSourceSyntax $ + mconcat [ emit "(", fromPgSelect (fromSyntax tblPfx), emit ")" ]) + (Just (tName, Just names))) + (\tName -> + let (projection, _) = mkFieldNames @Postgres @res (qualifiedField tName) + in projection) + (\_ -> Nothing) + snd)) + -- | By default, Postgres will throw an error when a conflict is detected. This -- preserves that functionality. onConflictDefault :: PgInsertOnConflict tbl diff --git a/flake.nix b/flake.nix index 63ca2ac8..f63da751 100644 --- a/flake.nix +++ b/flake.nix @@ -1,20 +1,27 @@ -let nixhash = import ./nix/nixhash.nix; -in { - inputs.nixpkgs.url = "github:nixos/nixpkgs/${nixhash}"; +{ + inputs.nixpkgs.url = "github:nixos/nixpkgs/85bcb95aa83be667e562e781e9d186c57a07d757"; inputs.flake-utils.url = "github:numtide/flake-utils"; outputs = { nixpkgs, flake-utils, self, ... }: - flake-utils.lib.forEachSystem (system: + flake-utils.lib.eachDefaultSystem (system: let pkgs = import nixpkgs { inherit system; }; beamLib = import ./nix/lib.nix { nixpkgs = pkgs; }; - beamGhc = beamLib.makeBeamGhc ghc; - in { - devShells.default = beamGhc.shellFor { - packages = beamLib.beamPackageList; - nativeBuildInputs = [ + beamGhc = beamLib.makeBeamGhc pkgs.haskellPackages; + + shellWithNativeInputs = nis: beamGhc.shellFor { + packages = beamLib.beamPackageList; + nativeBuildInputs = nis; + }; + in rec { + devShells.default = shellWithNativeInputs (with pkgs; [ postgresql sqlite-interactive - cabal-install - ]; - }; + cabal-install haskell-language-server + ]); + + devShells.build = shellWithNativeInputs []; # Shell only for building + devShells.test = shellWithNativeInputs (with pkgs; [ postgresql sqlite-interactive ]); + + devShells.docs = shellWithNativeInputs (with pkgs; [ postgresql sqlite-interactive + (python3.withPackages (ps: with ps; [ mkdocs mkdocs-material sqlparse ])) ]); }); } From d8f9e7ab88c570c44894da5c15d739125f0850fc Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:10:18 +0000 Subject: [PATCH 4/6] Remove flake from this branch --- flake.nix | 27 --------------------------- 1 file changed, 27 deletions(-) delete mode 100644 flake.nix diff --git a/flake.nix b/flake.nix deleted file mode 100644 index f63da751..00000000 --- a/flake.nix +++ /dev/null @@ -1,27 +0,0 @@ -{ - inputs.nixpkgs.url = "github:nixos/nixpkgs/85bcb95aa83be667e562e781e9d186c57a07d757"; - inputs.flake-utils.url = "github:numtide/flake-utils"; - - outputs = { nixpkgs, flake-utils, self, ... }: - flake-utils.lib.eachDefaultSystem (system: - let pkgs = import nixpkgs { inherit system; }; - beamLib = import ./nix/lib.nix { nixpkgs = pkgs; }; - beamGhc = beamLib.makeBeamGhc pkgs.haskellPackages; - - shellWithNativeInputs = nis: beamGhc.shellFor { - packages = beamLib.beamPackageList; - nativeBuildInputs = nis; - }; - in rec { - devShells.default = shellWithNativeInputs (with pkgs; [ - postgresql sqlite-interactive - cabal-install haskell-language-server - ]); - - devShells.build = shellWithNativeInputs []; # Shell only for building - devShells.test = shellWithNativeInputs (with pkgs; [ postgresql sqlite-interactive ]); - - devShells.docs = shellWithNativeInputs (with pkgs; [ postgresql sqlite-interactive - (python3.withPackages (ps: with ps; [ mkdocs mkdocs-material sqlparse ])) ]); - }); -} From 5aaeac414442a9a9695ffadae8082badcccc69e3 Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:12:27 +0000 Subject: [PATCH 5/6] Remove flake.lock --- flake.lock | 61 ------------------------------------------------------ 1 file changed, 61 deletions(-) delete mode 100644 flake.lock diff --git a/flake.lock b/flake.lock deleted file mode 100644 index 72fb323a..00000000 --- a/flake.lock +++ /dev/null @@ -1,61 +0,0 @@ -{ - "nodes": { - "flake-utils": { - "inputs": { - "systems": "systems" - }, - "locked": { - "lastModified": 1726560853, - "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "nixpkgs": { - "locked": { - "lastModified": 1686331006, - "narHash": "sha256-hElRDWUNG655aqF0awu+h5cmDN+I/dQcChRt2tGuGGU=", - "owner": "nixos", - "repo": "nixpkgs", - "rev": "85bcb95aa83be667e562e781e9d186c57a07d757", - "type": "github" - }, - "original": { - "owner": "nixos", - "repo": "nixpkgs", - "rev": "85bcb95aa83be667e562e781e9d186c57a07d757", - "type": "github" - } - }, - "root": { - "inputs": { - "flake-utils": "flake-utils", - "nixpkgs": "nixpkgs" - } - }, - "systems": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } - } - }, - "root": "root", - "version": 7 -} From 6100bc56c5f8b0e4070e468f8393e68b5e22682b Mon Sep 17 00:00:00 2001 From: Travis Athougies Date: Fri, 18 Oct 2024 18:14:49 +0000 Subject: [PATCH 6/6] Document pgSelectWith --- docs/user-guide/backends/beam-postgres.md | 54 +++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/docs/user-guide/backends/beam-postgres.md b/docs/user-guide/backends/beam-postgres.md index 46746fc0..d8b2e80b 100644 --- a/docs/user-guide/backends/beam-postgres.md +++ b/docs/user-guide/backends/beam-postgres.md @@ -274,3 +274,57 @@ runInsert $ ) ``` +### Inner CTEs + +Standard SQL only allows CTEs (`WITH` expressions) at the top-level SELECT. However, PostgreSQL +allows them anywhere, including in subqueries for joins. + +For example, the following is valid Postgres, but not valid standard SQL. + +```sql +SELECT a.column1, b.column2 +FROM (WITH RECURSIVE ... SELECT ...) a +INNER JOIN b +``` + +`beam-core` enforces this by forcing `selectWith` to only return a `SqlSelect`, which represents a +top-level SQL `SELECT` statement that can be executed against a backend. However, if we want to +allow `WITH` expressions to appear within joins, then we will need a function similar to +`selectWith` but returning a `Q` value, which is a re-usable query. `beam-postgres` provides this +function for PostgreSQL, named `pgSelectWith`. For `beam-postgres`, `select (pgSelectWith x)` is +equivalent to `selectWith x`. But, with the new type, we can reuse CTEs (including recursive ones) +within other queries. + +As an example using our Chinook schema, suppose we had an error with all orders in the month of +September 2024, and needed to send out employees to customer homes to correct the issue. We want to +find, for each order, an employee who lives in the same city as the customer, but we only want the +highest ranking employee for each customer. + +First, we order the employees by org structure so that managers appear first, followed by direct reports. We use a recursive query for this, and then join it against the orders. + +!beam-query +```haskell +!example chinook only:Postgres +aggregate_ (\(cust, emp) -> (group_ cust, Pg.pgArrayAgg (employeeId emp))) + $ do inv <- filter_ (\i -> invoiceDate i >=. val_ (read "2024-09-01 00:00:00.000000") &&. invoiceDate i <=. val_ (read "2024-10-01 00:00:00.000000")) $ all_ (invoice chinookDb) + cust <- lookup_ (customer chinookDb) (invoiceCustomer inv) + -- Lookup all employees and their levels + (employee, _, _) <- + Pg.pgSelectWith $ do + let topLevelEmployees = + fmap (\e -> (e, val_ (via @Int32 0))) $ + filter_ (\e -> isNull_ (employeeReportsTo e)) $ all_ (employee chinookDb) + rec employeeOrgChart <- + selecting (topLevelEmployees `unionAll_` + do { (manager, managerLevel) <- reuse employeeOrgChart + ; report <- filter_ (\e -> employeeReportsTo e ==. manager) $ all_ (employee chinookDb) + ; pure (report, managerLevel + val_ 1) }) + pure $ filter_ (\(employee, level, minLevel) -> level ==. minLevel) + $ withWindow_ (\(employee, level) -> frame_ (partitionBy_ (addressCity (employeeAddress employee))) noOrder_ noBounds_) + (\(employee, level) cityFrame -> + (employee, level, coalesce_ [min_ level `over_` cityFrame] (val_ 0))) + (reuse employeeOrgChart) + -- Limit the search only to employees that live in the same city + guard_ (addressCity (employeeAddress employee) ==. addressCity (customerAddress cust)) + pure (cust, employee) +```