diff --git a/beam-core/Database/Beam/Backend/SQL/SQL99.hs b/beam-core/Database/Beam/Backend/SQL/SQL99.hs index c7a24670..82b85d6d 100644 --- a/beam-core/Database/Beam/Backend/SQL/SQL99.hs +++ b/beam-core/Database/Beam/Backend/SQL/SQL99.hs @@ -16,6 +16,7 @@ module Database.Beam.Backend.SQL.SQL99 import Database.Beam.Backend.SQL.SQL92 import Data.Kind ( Type ) +import Data.List.NonEmpty ( NonEmpty ) import Data.Text ( Text ) class IsSql92SelectSyntax select => @@ -56,12 +57,12 @@ class IsSql92SelectSyntax syntax => IsSql99CommonTableExpressionSelectSyntax syntax where type Sql99SelectCTESyntax syntax :: Type - withSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax + withSyntax :: NonEmpty (Sql99SelectCTESyntax syntax) -> syntax -> syntax class IsSql99CommonTableExpressionSelectSyntax syntax => IsSql99RecursiveCommonTableExpressionSelectSyntax syntax where - withRecursiveSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax + withRecursiveSyntax :: NonEmpty (Sql99SelectCTESyntax syntax) -> syntax -> syntax class IsSql99CommonTableExpressionSyntax syntax where type Sql99CTESelectSyntax syntax :: Type diff --git a/beam-core/Database/Beam/Query.hs b/beam-core/Database/Beam/Query.hs index b67a275b..b4a69549 100644 --- a/beam-core/Database/Beam/Query.hs +++ b/beam-core/Database/Beam/Query.hs @@ -123,6 +123,7 @@ import Control.Monad.State.Strict import Data.Kind (Type) import Data.Functor.Const (Const(..)) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import Data.Proxy @@ -159,11 +160,16 @@ selectWith :: forall be db res => With be db (Q be db QBaseScope res) -> SqlSelect be (QExprToIdentity res) selectWith (CTE.With mkQ) = let (q, (recursiveness, ctes)) = evalState (runWriterT mkQ) 0 - in case recursiveness of - CTE.Nonrecursive -> SqlSelect (withSyntax ctes - (buildSqlQuery "t" q)) - CTE.Recursive -> SqlSelect (withRecursiveSyntax ctes - (buildSqlQuery "t" q)) + in case (recursiveness, nonEmpty ctes) of + (CTE.Nonrecursive, Just ctes') -> SqlSelect (withSyntax ctes' + (buildSqlQuery "t" q)) + (CTE.Recursive, Just ctes') -> SqlSelect (withRecursiveSyntax ctes' + (buildSqlQuery "t" q)) + {- `WITH` clauses should not be used when no CTEs are created. + + See: https://github.com/haskell-beam/beam/issues/760 + -} + (_, Nothing) -> SqlSelect (buildSqlQuery "t" q) -- | Convenience function to generate a 'SqlSelect' that looks up a table row -- given a primary key. diff --git a/beam-postgres/Database/Beam/Postgres/Full.hs b/beam-postgres/Database/Beam/Postgres/Full.hs index 18c7f0d6..d5915c5d 100644 --- a/beam-postgres/Database/Beam/Postgres/Full.hs +++ b/beam-postgres/Database/Beam/Postgres/Full.hs @@ -72,6 +72,7 @@ import Control.Monad.State.Strict (evalState) import Control.Monad.Writer (runWriterT) import Data.Kind (Type) +import Data.List.NonEmpty (nonEmpty) import Data.Proxy (Proxy(..)) import qualified Data.Text as T @@ -298,9 +299,10 @@ pgSelectWith :: forall 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) + case (recursiveness, nonEmpty ctes) of + (CTE.Nonrecursive, Just ctes') -> withSyntax ctes' (buildSqlQuery tblPfx q) + (CTE.Recursive, Just ctes') -> withRecursiveSyntax ctes' (buildSqlQuery tblPfx q) + (_, Nothing) -> buildSqlQuery tblPfx q in Q (liftF (QAll (\tblPfx tName -> let (_, names) = mkFieldNames @Postgres @res (qualifiedField tName) in fromTable (PgTableSourceSyntax $ diff --git a/beam-postgres/Database/Beam/Postgres/Syntax.hs b/beam-postgres/Database/Beam/Postgres/Syntax.hs index 59925d04..0d16a676 100644 --- a/beam-postgres/Database/Beam/Postgres/Syntax.hs +++ b/beam-postgres/Database/Beam/Postgres/Syntax.hs @@ -110,6 +110,7 @@ import Data.Coerce import Data.Functor.Classes import Data.Hashable import Data.Int +import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe import Data.Scientific (Scientific) import Data.String (IsString(..), fromString) @@ -589,14 +590,14 @@ instance IsSql99CommonTableExpressionSelectSyntax PgSelectSyntax where withSyntax ctes (PgSelectSyntax select) = PgSelectSyntax $ emit "WITH " <> - pgSepBy (emit ", ") (map fromPgCommonTableExpression ctes) <> + pgSepBy (emit ", ") (map fromPgCommonTableExpression $ NonEmpty.toList ctes) <> select instance IsSql99RecursiveCommonTableExpressionSelectSyntax PgSelectSyntax where withRecursiveSyntax ctes (PgSelectSyntax select) = PgSelectSyntax $ emit "WITH RECURSIVE " <> - pgSepBy (emit ", ") (map fromPgCommonTableExpression ctes) <> + pgSepBy (emit ", ") (map fromPgCommonTableExpression $ NonEmpty.toList ctes) <> select instance IsSql99CommonTableExpressionSyntax PgCommonTableExpressionSyntax where