diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,17 @@ # Revision history for beam-duckdb -## 0.1.1.0 -- unreleased +## 0.2.0.0 -- 2026-03-07 + +* Support for the SQL99 feature set, including support for regex matching via `similarTo_` and common table expressions + (both non-recursive and recursive); +* Support for the SQL2003 feature set, including OLAP functionality such as windowed aggregation and `FILTER`; +* Exposed the `DataSource` type, but without constructors. Use `parquet`, `csv`, or any of the other + helper functions to construct a `DataSource`; +* Fixed an issue where the SQL queries generated via `allIn_` and `anyIn_` were not supported by DuckDB. +* Fixed an issue with `HasSqlValueSyntax DuckDB` instances overlapping. Users must now derive instances manually for + custom types. This is a breaking change. + +## 0.1.1.0 -- 2026-03-04 * Fixed an issue with modeling boolean conditions, whereby, for example, checking if something was true was modeled as `... IS 1` (as for Sqlite), rather than `... IS TRUE` (like Postgres). * Added a `FromBackendRow DuckDB Scientific`, `HasSqlEqualityCheck DuckDB Scientific`, and `HasSqlQuantifiedEqualityCheck DuckDB Scientific` instances, which are required to build the documentation. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -18,7 +18,7 @@ * The duckdb files are in `/usr/lib/duckdb` * You're using duckdb 1.4.* -For Linux you can install a blessed version of duckdb in the correct path by cloining the duckdb-hasekll repo and running `make install` in the [duckdb-ffi cbits folder](https://github.com/Tritlo/duckdb-haskell/tree/main/duckdb-ffi/cbits). +For Linux you can install a blessed version of duckdb in the correct path by cloning the duckdb-haskell repo and running `make install` in the [duckdb-ffi cbits folder](https://github.com/Tritlo/duckdb-haskell/tree/main/duckdb-ffi/cbits). ## Example diff --git a/beam-duckdb.cabal b/beam-duckdb.cabal --- a/beam-duckdb.cabal +++ b/beam-duckdb.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: beam-duckdb -version: 0.1.1.0 +version: 0.2.0.0 synopsis: DuckDB backend for Beam description: Beam driver for DuckDB, an analytics-focused open-source in-process database. license: MIT diff --git a/src/Database/Beam/DuckDB.hs b/src/Database/Beam/DuckDB.hs --- a/src/Database/Beam/DuckDB.hs +++ b/src/Database/Beam/DuckDB.hs @@ -20,6 +20,7 @@ module Database.Beam.DuckDB ( -- * Executing DuckDB queries runBeamDuckDB, + -- ** Executing DuckDB queries with debugging runBeamDuckDBDebug, runBeamDuckDBDebugString, @@ -31,6 +32,7 @@ -- * DuckDB-specific functionality -- ** Data sources + DataSource, DataSourceEntity, dataSource, modifyDataSourceFields, @@ -174,7 +176,7 @@ ) ) Just (UnexpectedNull {}) -> - Just (SomeException (BeamRowReadError col ColumnUnexpectedNull)) + Just (SomeException (BeamRowReadError {brreColumn = col, brreError = ColumnUnexpectedNull})) Just ( Incompatible { errSQLType = typeString, diff --git a/src/Database/Beam/DuckDB/Syntax.hs b/src/Database/Beam/DuckDB/Syntax.hs --- a/src/Database/Beam/DuckDB/Syntax.hs +++ b/src/Database/Beam/DuckDB/Syntax.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -6,56 +7,81 @@ -- TODO: clean up unused top binds {-# OPTIONS_GHC -Wno-unused-top-binds #-} -module Database.Beam.DuckDB.Syntax ( - -- * Command - DuckDBCommandSyntax (..), +module Database.Beam.DuckDB.Syntax + ( -- * Command + DuckDBCommandSyntax (..), - -- * Concrete syntaxes - DuckDBSelectSyntax (..), - DuckDBFromSyntax (..), - DuckDBExpressionSyntax (..), - DuckDBInsertSyntax (..), - DuckDBUpdateSyntax (..), - DuckDBDeleteSyntax (..), - DuckDBTableNameSyntax (..), - DuckDBOnConflictSyntax (..), -) + -- * Concrete syntaxes + DuckDBSelectSyntax (..), + DuckDBFromSyntax (..), + DuckDBExpressionSyntax (..), + DuckDBInsertSyntax (..), + DuckDBUpdateSyntax (..), + DuckDBDeleteSyntax (..), + DuckDBTableNameSyntax (..), + DuckDBOnConflictSyntax (..), + ) where +import Data.Bifunctor (second) import Data.Coerce (coerce) import Data.Int (Int16, Int32, Int64, Int8) +import Data.Scientific (Scientific) import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Lazy as Lazy +import Data.Time (Day, LocalTime, TimeOfDay, UTCTime) import Data.Word (Word16, Word32, Word64, Word8) -import Database.Beam.Backend ( - HasSqlValueSyntax (..), - IsSql92AggregationExpressionSyntax (..), - IsSql92AggregationSetQuantifierSyntax (..), - IsSql92DataTypeSyntax (..), - IsSql92DeleteSyntax (..), - IsSql92ExpressionSyntax (..), - IsSql92ExtractFieldSyntax (..), - IsSql92FieldNameSyntax (..), - IsSql92FromOuterJoinSyntax (..), - IsSql92FromSyntax (..), - IsSql92GroupingSyntax (..), - IsSql92InsertSyntax (..), - IsSql92InsertValuesSyntax (..), - IsSql92OrderingSyntax (..), - IsSql92ProjectionSyntax (..), - IsSql92QuantifierSyntax (..), - IsSql92SelectSyntax (..), - IsSql92SelectTableSyntax (..), - IsSql92Syntax (..), - IsSql92TableNameSyntax (..), - IsSql92TableSourceSyntax (..), - IsSql92UpdateSyntax (..), - SqlNull (..), - ) -import Database.Beam.DuckDB.Syntax.Builder (DuckDBSyntax, commas, emit, emitIntegral, emitRealFloat, emitValue, parens, quotedIdentifier, spaces) +import Database.Beam.Backend + ( HasSqlValueSyntax (..), + IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax (..), + IsSql2003EnhancedNumericFunctionsExpressionSyntax (..), + IsSql2003ExpressionAdvancedOLAPOperationsSyntax (..), + IsSql2003ExpressionElementaryOLAPOperationsSyntax (..), + IsSql2003ExpressionSyntax (..), + IsSql2003FirstValueAndLastValueExpressionSyntax (..), + IsSql2003LeadAndLagExpressionSyntax (..), + IsSql2003NthValueExpressionSyntax (..), + IsSql2003NtileExpressionSyntax (..), + IsSql2003OrderingElementaryOLAPOperationsSyntax (..), + IsSql2003WindowFrameBoundSyntax (..), + IsSql2003WindowFrameBoundsSyntax (..), + IsSql2003WindowFrameSyntax (..), + IsSql92AggregationExpressionSyntax (..), + IsSql92AggregationSetQuantifierSyntax (..), + IsSql92DataTypeSyntax (..), + IsSql92DeleteSyntax (..), + IsSql92ExpressionSyntax (..), + IsSql92ExtractFieldSyntax (..), + IsSql92FieldNameSyntax (..), + IsSql92FromOuterJoinSyntax (..), + IsSql92FromSyntax (..), + IsSql92GroupingSyntax (..), + IsSql92InsertSyntax (..), + IsSql92InsertValuesSyntax (..), + IsSql92OrderingSyntax (..), + IsSql92ProjectionSyntax (..), + IsSql92QuantifierSyntax (..), + IsSql92SelectSyntax (..), + IsSql92SelectTableSyntax (..), + IsSql92Syntax (..), + IsSql92TableNameSyntax (..), + IsSql92TableSourceSyntax (..), + IsSql92UpdateSyntax (..), + IsSql99AggregationExpressionSyntax (..), + IsSql99CommonTableExpressionSelectSyntax (..), + IsSql99CommonTableExpressionSyntax (..), + IsSql99ConcatExpressionSyntax (..), + IsSql99DataTypeSyntax (..), + IsSql99ExpressionSyntax (..), + IsSql99FunctionExpressionSyntax (..), + IsSql99RecursiveCommonTableExpressionSelectSyntax (..), + SqlNull (..), + ) +import Database.Beam.DuckDB.Syntax.Builder (DuckDBSyntax, commas, emit, emitChar, emitIntegral, emitRealFloat, emitScientific, emitValue, parens, quotedIdentifier, sepBy, spaces) import Database.Beam.Migrate.Serialization (BeamSerializedDataType) -import Database.DuckDB.Simple (Null (Null), ToField) +import Database.DuckDB.Simple (Null (Null)) newtype DuckDBCommandSyntax = DuckDBCommandSyntax {fromDuckDBSyntax :: DuckDBSyntax} @@ -78,17 +104,7 @@ newtype DuckDBSelectTableSyntax = DuckDBSelectTableSyntax {fromDuckDBSelectTable :: DuckDBSyntax} -data DuckDBOrderingSyntax = DuckDBOrderingSyntax - { duckDBOrdering :: DuckDBSyntax - , -- DuckDB re-uses the Postgres parser, and therefore - -- has the same null ordering properties - duckDBNullOrdering :: Maybe DuckDBNullOrdering - } - -data DuckDBNullOrdering - = DuckDBNullOrderingNullsFirst - | DuckDBNullOrderingNullsLast - deriving (Show, Eq) +newtype DuckDBOrderingSyntax = DuckDBOrderingSyntax {fromDuckDBOrdering :: DuckDBSyntax} newtype DuckDBExpressionSyntax = DuckDBExpressionSyntax {fromDuckDBExpression :: DuckDBSyntax} deriving (Eq) @@ -105,8 +121,8 @@ newtype DuckDBComparisonQuantifierSyntax = DuckDBComparisonQuantifierSyntax {fromDuckDBComparisonQuantifier :: DuckDBSyntax} data DuckDBDataTypeSyntax = DuckDBDataTypeSyntax - { duckDBDataType :: DuckDBSyntax - , duckDBDataTypeSerialized :: BeamSerializedDataType + { duckDBDataType :: DuckDBSyntax, + duckDBDataTypeSerialized :: BeamSerializedDataType } newtype DuckDBExtractFieldSyntax = DuckDBExtractFieldSyntax {fromDuckDBExtractField :: DuckDBSyntax} @@ -117,6 +133,14 @@ newtype DuckDBAggregationSetQuantifierSyntax = DuckDBAggregationSetQuantifierSyntax {fromDuckDBAggregationSetQuantifier :: DuckDBSyntax} +newtype DuckDBCommonTableExpressionSyntax = DuckDBCommonTableExpressionSyntax {fromDuckDBCommonTableExpressionSyntax :: DuckDBSyntax} + +newtype DuckDBWindowFrameSyntax = DuckDBWindowFrameSyntax {fromDuckDBWindowFrame :: DuckDBSyntax} + +newtype DuckDBWindowFrameBoundsSyntax = DuckDBWindowFrameBoundsSyntax {fromDuckDBWindowFrameBounds :: DuckDBSyntax} + +newtype DuckDBWindowFrameBoundSyntax = DuckDBWindowFrameBoundSyntax {fromDuckDBWindowFrameBound :: Text -> DuckDBSyntax} + instance IsSql92AggregationExpressionSyntax DuckDBExpressionSyntax where type Sql92AggregationSetQuantifierSyntax DuckDBExpressionSyntax = DuckDBAggregationSetQuantifierSyntax @@ -143,13 +167,13 @@ selectTableStmt setQuantifier proj from where_ grouping having = DuckDBSelectTableSyntax $ mconcat - [ emit "SELECT " - , maybe mempty ((<> emit " ") . fromDuckDBAggregationSetQuantifier) setQuantifier - , fromDuckDBProjection proj - , maybe mempty ((emit " FROM " <>) . fromDuckDBFrom) from - , maybe mempty ((emit " WHERE " <>) . fromDuckDBExpression) where_ - , maybe mempty ((emit " GROUP BY " <>) . fromDuckDBGrouping) grouping - , maybe mempty ((emit " HAVING " <>) . fromDuckDBExpression) having + [ emit "SELECT ", + maybe mempty ((<> emit " ") . fromDuckDBAggregationSetQuantifier) setQuantifier, + fromDuckDBProjection proj, + maybe mempty ((emit " FROM " <>) . fromDuckDBFrom) from, + maybe mempty ((emit " WHERE " <>) . fromDuckDBExpression) where_, + maybe mempty ((emit " GROUP BY " <>) . fromDuckDBGrouping) grouping, + maybe mempty ((emit " HAVING " <>) . fromDuckDBExpression) having ] unionTables unionAll = tableOp (if unionAll then "UNION ALL" else "UNION") @@ -307,6 +331,24 @@ (emit "TIMESTAMP" <> optPrec prec <> if withTz then emit " WITH TIME ZONE" else mempty) (timestampType prec withTz) +instance IsSql99DataTypeSyntax DuckDBDataTypeSyntax where + characterLargeObjectType = DuckDBDataTypeSyntax {duckDBDataType = emit "TEXT", duckDBDataTypeSerialized = characterLargeObjectType} + binaryLargeObjectType = DuckDBDataTypeSyntax {duckDBDataType = emit "BYTEA", duckDBDataTypeSerialized = binaryLargeObjectType} + booleanType = DuckDBDataTypeSyntax (emit "BOOLEAN") booleanType + arrayType (DuckDBDataTypeSyntax syntax serialized) sz = + DuckDBDataTypeSyntax + (syntax <> emit "[" <> emit (fromString (show sz)) <> emit "]") + (arrayType serialized sz) + rowType fields = + DuckDBDataTypeSyntax + { duckDBDataType = + -- Note that DuckDB's support for ROW is effectively STRUCT, as far as I understand + emit "STRUCT(" + <> sepBy (emit ", ") (map (\(fieldName, DuckDBDataTypeSyntax t _) -> emit fieldName <> emit " " <> t) fields) + <> emitChar ')', + duckDBDataTypeSerialized = rowType (map (second duckDBDataTypeSerialized) fields) + } + optPrec :: Maybe Word -> DuckDBSyntax optPrec Nothing = mempty optPrec (Just x) = emit "(" <> emit (fromString (show x)) <> emit ")" @@ -350,6 +392,9 @@ instance HasSqlValueSyntax DuckDBValueSyntax Double where sqlValueSyntax f = DuckDBValueSyntax (emitRealFloat f) +instance HasSqlValueSyntax DuckDBValueSyntax Scientific where + sqlValueSyntax f = DuckDBValueSyntax (emitScientific f) + instance HasSqlValueSyntax DuckDBValueSyntax Bool where sqlValueSyntax = DuckDBValueSyntax . emitValue @@ -362,9 +407,21 @@ instance HasSqlValueSyntax DuckDBValueSyntax Text where sqlValueSyntax = DuckDBValueSyntax . emitValue -instance {-# OVERLAPPABLE #-} (ToField a, Eq a) => HasSqlValueSyntax DuckDBValueSyntax a where +instance HasSqlValueSyntax DuckDBValueSyntax Lazy.Text where + sqlValueSyntax = sqlValueSyntax . Lazy.toStrict + +instance HasSqlValueSyntax DuckDBValueSyntax Day where sqlValueSyntax = DuckDBValueSyntax . emitValue +instance HasSqlValueSyntax DuckDBValueSyntax TimeOfDay where + sqlValueSyntax = DuckDBValueSyntax . emitValue + +instance HasSqlValueSyntax DuckDBValueSyntax LocalTime where + sqlValueSyntax = DuckDBValueSyntax . emitValue + +instance HasSqlValueSyntax DuckDBValueSyntax UTCTime where + sqlValueSyntax = DuckDBValueSyntax . emitValue + instance (HasSqlValueSyntax DuckDBValueSyntax x) => HasSqlValueSyntax DuckDBValueSyntax (Maybe x) where sqlValueSyntax (Just x) = sqlValueSyntax x sqlValueSyntax Nothing = sqlValueSyntax SqlNull @@ -421,6 +478,9 @@ valueE = DuckDBExpressionSyntax . fromDuckDBValue rowE vs = DuckDBExpressionSyntax (parens (commas (map fromDuckDBExpression vs))) + quantifierListE vs = + DuckDBExpressionSyntax $ + emit "(VALUES " <> sepBy (emit ", ") (fmap (parens . coerce) vs) <> emit ")" fieldE = DuckDBExpressionSyntax . fromDuckDBFieldName subqueryE = DuckDBExpressionSyntax . parens . fromDuckDBSelect @@ -497,9 +557,13 @@ instance IsSql92OrderingSyntax DuckDBOrderingSyntax where type Sql92OrderingExpressionSyntax DuckDBOrderingSyntax = DuckDBExpressionSyntax - ascOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " ASC") Nothing - descOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " DESC") Nothing + ascOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " ASC") + descOrdering e = DuckDBOrderingSyntax (fromDuckDBExpression e <> emit " DESC") +instance IsSql2003OrderingElementaryOLAPOperationsSyntax DuckDBOrderingSyntax where + nullsFirstOrdering o = DuckDBOrderingSyntax $ coerce o <> emit " NULLS FIRST" + nullsLastOrdering o = DuckDBOrderingSyntax $ coerce o <> emit " NULLS LAST" + instance IsSql92SelectSyntax DuckDBSelectSyntax where type Sql92SelectSelectTableSyntax DuckDBSelectSyntax = DuckDBSelectTableSyntax type Sql92SelectOrderingSyntax DuckDBSelectSyntax = DuckDBOrderingSyntax @@ -507,12 +571,12 @@ selectStmt tbl ordering limit offset = DuckDBSelectSyntax $ mconcat - [ fromDuckDBSelectTable tbl - , case ordering of + [ fromDuckDBSelectTable tbl, + case ordering of [] -> mempty - ordering' -> emit " ORDER BY " <> commas (map duckDBOrdering ordering') - , maybe mempty (emit . fromString . (" LIMIT " <>) . show) limit - , maybe mempty (emit . fromString . (" OFFSET " <>) . show) offset + ordering' -> emit " ORDER BY " <> commas (map coerce ordering'), + maybe mempty (emit . fromString . (" LIMIT " <>) . show) limit, + maybe mempty (emit . fromString . (" OFFSET " <>) . show) offset ] -- | DuckDB @ON CONFLICT@ syntax @@ -585,3 +649,207 @@ <> maybe mempty (\whereInner -> emit " WHERE " <> fromDuckDBExpression whereInner) where_ deleteSupportsAlias _ = True + +instance IsSql99CommonTableExpressionSelectSyntax DuckDBSelectSyntax where + type Sql99SelectCTESyntax DuckDBSelectSyntax = DuckDBCommonTableExpressionSyntax + + withSyntax ctes (DuckDBSelectSyntax select) = + DuckDBSelectSyntax $ + emit "WITH " + <> sepBy (emit ", ") (map fromDuckDBCommonTableExpressionSyntax ctes) + <> select + +instance IsSql99RecursiveCommonTableExpressionSelectSyntax DuckDBSelectSyntax where + withRecursiveSyntax ctes (DuckDBSelectSyntax select) = + DuckDBSelectSyntax $ + emit "WITH RECURSIVE " + <> sepBy (emit ", ") (map fromDuckDBCommonTableExpressionSyntax ctes) + <> select + +instance IsSql99CommonTableExpressionSyntax DuckDBCommonTableExpressionSyntax where + type Sql99CTESelectSyntax DuckDBCommonTableExpressionSyntax = DuckDBSelectSyntax + + cteSubquerySyntax tbl fields (DuckDBSelectSyntax select) = + DuckDBCommonTableExpressionSyntax $ + quotedIdentifier tbl + <> parens (sepBy (emit ",") (map quotedIdentifier fields)) + <> emit " AS " + <> parens select + +instance IsSql99FunctionExpressionSyntax DuckDBExpressionSyntax where + functionCallE name args = + DuckDBExpressionSyntax $ + fromDuckDBExpression name + <> parens (sepBy (emit ", ") (map fromDuckDBExpression args)) + functionNameE nm = DuckDBExpressionSyntax (emit nm) + +instance IsSql99ExpressionSyntax DuckDBExpressionSyntax where + -- The implementation of 'distinctE' is the same as Postgres', but its + -- use via 'distinct_' creates SQL queries which are not necessarily supported + distinctE select = DuckDBExpressionSyntax (emit "DISTINCT (" <> fromDuckDBSelect select <> emit ")") + + -- DuckDB doesn't support 'SIMILAR TO' exactly, but rather + -- provides the 'regexp_matches' function + similarToE left right = + DuckDBExpressionSyntax $ + mconcat + [ emit "regexp_matches(", + coerce left, + emit ", ", + coerce right, + emitChar ')' + ] + + instanceFieldE i nm = + DuckDBExpressionSyntax $ + parens (fromDuckDBExpression i) <> emit "." <> quotedIdentifier nm + + refFieldE i nm = + DuckDBExpressionSyntax $ + parens (fromDuckDBExpression i) <> emit "->" <> quotedIdentifier nm + +instance IsSql99ConcatExpressionSyntax DuckDBExpressionSyntax where + concatE [] = valueE (sqlValueSyntax ("" :: Text)) + concatE [x] = x + concatE es = + DuckDBExpressionSyntax $ + emit "CONCAT" + <> parens + ( sepBy + (emit ", ") + -- DuckDB's type inference doesn't work reliably inside of CONCAT. I suspect + -- that this is only for ? parameters for binding. + -- However, to be extra safe, we cast every element inside the `CONCAT` call + -- to a VARCHAR + -- TODO: optimize this to only CAST when the expression is a binding parameter + (map (\e -> emit "CAST" <> parens (coerce e <> emit " AS VARCHAR")) es) + ) + +instance IsSql99AggregationExpressionSyntax DuckDBExpressionSyntax where + everyE = aggFunc "BOOL_AND" -- DuckDB doesn't implement 'EVERY' + + -- The following two functions are modeled the same way + -- as for the Postgres backend + someE = aggFunc "BOOL_OR" + anyE = aggFunc "BOOL_OR" + +instance IsSql2003ExpressionSyntax DuckDBExpressionSyntax where + type + Sql2003ExpressionWindowFrameSyntax DuckDBExpressionSyntax = + DuckDBWindowFrameSyntax + + overE expr frame = + DuckDBExpressionSyntax $ + fromDuckDBExpression expr <> emit " " <> fromDuckDBWindowFrame frame + rowNumberE = DuckDBExpressionSyntax $ emit "ROW_NUMBER()" + +instance IsSql2003EnhancedNumericFunctionsExpressionSyntax DuckDBExpressionSyntax where + lnE x = DuckDBExpressionSyntax (emit "LN(" <> fromDuckDBExpression x <> emit ")") + expE x = DuckDBExpressionSyntax (emit "EXP(" <> fromDuckDBExpression x <> emit ")") + sqrtE x = DuckDBExpressionSyntax (emit "SQRT(" <> fromDuckDBExpression x <> emit ")") + ceilE x = DuckDBExpressionSyntax (emit "CEIL(" <> fromDuckDBExpression x <> emit ")") + floorE x = DuckDBExpressionSyntax (emit "FLOOR(" <> fromDuckDBExpression x <> emit ")") + powerE x y = DuckDBExpressionSyntax (emit "POWER(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression y <> emit ")") + +instance IsSql2003ExpressionAdvancedOLAPOperationsSyntax DuckDBExpressionSyntax where + denseRankAggE = DuckDBExpressionSyntax $ emit "DENSE_RANK()" + percentRankAggE = DuckDBExpressionSyntax $ emit "PERCENT_RANK()" + cumeDistAggE = DuckDBExpressionSyntax $ emit "CUME_DIST()" + +instance IsSql2003ExpressionElementaryOLAPOperationsSyntax DuckDBExpressionSyntax where + rankAggE = DuckDBExpressionSyntax $ emit "RANK()" + filterAggE agg f = + DuckDBExpressionSyntax $ + fromDuckDBExpression agg <> emit " FILTER (WHERE " <> fromDuckDBExpression f <> emit ")" + +binAggFunc :: + Text -> + Maybe DuckDBAggregationSetQuantifierSyntax -> + DuckDBExpressionSyntax -> + DuckDBExpressionSyntax -> + DuckDBExpressionSyntax +binAggFunc fn q x y = + DuckDBExpressionSyntax $ + emit fn + <> emitChar '(' + <> maybe mempty (\inner -> fromDuckDBAggregationSetQuantifier inner <> emitChar ' ') q + <> fromDuckDBExpression x + <> emit ", " + <> fromDuckDBExpression y + <> emitChar ')' + +instance IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax DuckDBExpressionSyntax where + stddevPopE = aggFunc "STDDEV_POP" + stddevSampE = aggFunc "STDDEV_SAMP" + varPopE = aggFunc "VAR_POP" + varSampE = aggFunc "VAR_SAMP" + + covarPopE = binAggFunc "COVAR_POP" + covarSampE = binAggFunc "COVAR_SAMP" + corrE = binAggFunc "CORR" + regrSlopeE = binAggFunc "REGR_SLOPE" + regrInterceptE = binAggFunc "REGR_INTERCEPT" + regrCountE = binAggFunc "REGR_COUNT" + regrRSquaredE = binAggFunc "REGR_R2" + regrAvgXE = binAggFunc "REGR_AVGX" + regrAvgYE = binAggFunc "REGR_AVGY" + regrSXXE = binAggFunc "REGR_SXX" + regrSYYE = binAggFunc "REGR_SYY" + regrSXYE = binAggFunc "REGR_SXY" + +instance IsSql2003NtileExpressionSyntax DuckDBExpressionSyntax where + ntileE x = DuckDBExpressionSyntax (emit "NTILE(" <> fromDuckDBExpression x <> emit ")") + +instance IsSql2003LeadAndLagExpressionSyntax DuckDBExpressionSyntax where + leadE x Nothing Nothing = + DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ")") + leadE x (Just n) Nothing = + DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")") + leadE x (Just n) (Just def) = + DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ", " <> fromDuckDBExpression def <> emit ")") + leadE x Nothing (Just def) = + DuckDBExpressionSyntax (emit "LEAD(" <> fromDuckDBExpression x <> emit ", 1, " <> fromDuckDBExpression def <> emit ")") + + lagE x Nothing Nothing = + DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ")") + lagE x (Just n) Nothing = + DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")") + lagE x (Just n) (Just def) = + DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ", " <> fromDuckDBExpression def <> emit ")") + lagE x Nothing (Just def) = + DuckDBExpressionSyntax (emit "LAG(" <> fromDuckDBExpression x <> emit ", 1, " <> fromDuckDBExpression def <> emit ")") + +instance IsSql2003FirstValueAndLastValueExpressionSyntax DuckDBExpressionSyntax where + firstValueE x = DuckDBExpressionSyntax (emit "FIRST_VALUE(" <> fromDuckDBExpression x <> emit ")") + lastValueE x = DuckDBExpressionSyntax (emit "LAST_VALUE(" <> fromDuckDBExpression x <> emit ")") + +instance IsSql2003NthValueExpressionSyntax DuckDBExpressionSyntax where + nthValueE x n = DuckDBExpressionSyntax (emit "NTH_VALUE(" <> fromDuckDBExpression x <> emit ", " <> fromDuckDBExpression n <> emit ")") + +instance IsSql2003WindowFrameSyntax DuckDBWindowFrameSyntax where + type Sql2003WindowFrameExpressionSyntax DuckDBWindowFrameSyntax = DuckDBExpressionSyntax + type Sql2003WindowFrameOrderingSyntax DuckDBWindowFrameSyntax = DuckDBOrderingSyntax + type Sql2003WindowFrameBoundsSyntax DuckDBWindowFrameSyntax = DuckDBWindowFrameBoundsSyntax + + frameSyntax partition_ ordering_ bounds_ = + DuckDBWindowFrameSyntax $ + emit "OVER " + <> parens + ( maybe mempty (\p -> emit "PARTITION BY " <> sepBy (emit ", ") (map fromDuckDBExpression p)) partition_ + <> maybe mempty (\o -> emit " ORDER BY " <> sepBy (emit ", ") (map fromDuckDBOrdering o)) ordering_ + <> maybe mempty (\b -> emit " ROWS " <> fromDuckDBWindowFrameBounds b) bounds_ + ) + +instance IsSql2003WindowFrameBoundsSyntax DuckDBWindowFrameBoundsSyntax where + type Sql2003WindowFrameBoundsBoundSyntax DuckDBWindowFrameBoundsSyntax = DuckDBWindowFrameBoundSyntax + + fromToBoundSyntax from Nothing = + DuckDBWindowFrameBoundsSyntax (fromDuckDBWindowFrameBound from "PRECEDING") + fromToBoundSyntax from (Just to) = + DuckDBWindowFrameBoundsSyntax $ + emit "BETWEEN " <> fromDuckDBWindowFrameBound from "PRECEDING" <> emit " AND " <> fromDuckDBWindowFrameBound to "FOLLOWING" + +instance IsSql2003WindowFrameBoundSyntax DuckDBWindowFrameBoundSyntax where + unboundedSyntax = DuckDBWindowFrameBoundSyntax $ \where_ -> emit "UNBOUNDED " <> emit where_ + nrowsBoundSyntax 0 = DuckDBWindowFrameBoundSyntax $ \_ -> emit "CURRENT ROW" + nrowsBoundSyntax n = DuckDBWindowFrameBoundSyntax $ \where_ -> emit (fromString (show n)) <> emit " " <> emit where_ diff --git a/src/Database/Beam/DuckDB/Syntax/Builder.hs b/src/Database/Beam/DuckDB/Syntax/Builder.hs --- a/src/Database/Beam/DuckDB/Syntax/Builder.hs +++ b/src/Database/Beam/DuckDB/Syntax/Builder.hs @@ -8,6 +8,7 @@ emit, emitIntegral, emitRealFloat, + emitScientific, emit', emitValue, spaces, @@ -31,6 +32,8 @@ import Database.Beam.Backend (Sql92DisplaySyntax (..)) import Database.DuckDB.Simple (ToField (toField)) import Database.DuckDB.Simple.ToField (renderFieldBinding) +import Data.Scientific (Scientific) +import qualified Data.Text.Lazy.Builder.Scientific as Builder.Scientific data SomeField = forall a. (ToField a, Eq a) => SomeField a @@ -56,6 +59,9 @@ emitRealFloat :: (RealFloat f) => f -> DuckDBSyntax emitRealFloat f = DuckDBSyntax (const (Builder.realFloat f)) mempty + +emitScientific :: Scientific -> DuckDBSyntax +emitScientific s = DuckDBSyntax (const (Builder.Scientific.scientificBuilder s)) mempty emit' :: (Show a) => a -> DuckDBSyntax emit' s = DuckDBSyntax (const (Builder.fromString (show s))) mempty diff --git a/tests/Database/Beam/DuckDB/Test/Query.hs b/tests/Database/Beam/DuckDB/Test/Query.hs --- a/tests/Database/Beam/DuckDB/Test/Query.hs +++ b/tests/Database/Beam/DuckDB/Test/Query.hs @@ -3,14 +3,17 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} module Database.Beam.DuckDB.Test.Query (tests) where import Control.Monad (void) import Data.Int (Int32) -import Data.List (nubBy, sort, sortOn) +import Data.List (nub, nubBy, sort, sortOn) import Data.Text (Text) import Database.Beam ( Beamable, @@ -24,20 +27,64 @@ SqlValable (val_), Table (..), TableEntity, + aggregate_, + allInGroup_, all_, + anyOver_, + as_, + asc_, + avgOver_, + bounds_, + cast_, + concat_, + countAll_, dbModification, defaultDbSettings, + desc_, + double, + everyOver_, + filterWhere_, + filter_, + firstValue_, + frame_, + fromMaybe_, + group_, guard_, insert, insertValues, + isTrue_, + lagWithDefault_, + lastValue_, leftJoin_, modifyTableFields, + noBounds_, + noOrder_, + noPartition_, + nrows_, + orderBy_, + orderPartitionBy_, + over_, + partitionBy_, + references_, related_, + reuse, + rowNumber_, runInsert, runSelectReturningList, select, + selectWith, + selecting, + someOver_, + sqlBool_, + sumOver_, + sum_, tableModification, + unbounded_, + union_, + varchar, withDbModification, + withWindow_, + (<.), (>=.), ) import Database.Beam.DuckDB (DuckDB, runBeamDuckDB) @@ -46,30 +93,72 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.Hedgehog (testProperty) tests :: TestTree tests = testGroup - "Query" + "Queries" [ testGroup - "Selection" - [ testSelectAll, - testSelectWithFilter, - testSelectEquality + "SQL92 featureset" + [ testGroup + "Selection" + [ testSelectAll, + testSelectWithFilter, + testSelectEquality + ], + testGroup + "Projection" + [ testProjectSingleColumn, + testProjectMultipleColumns, + testProjectWithExpression + ], + testGroup + "Join" + [ testInnerJoin, + testMultiInnerJoin, + testMixingJoinsWithFilters, + testLeftJoin + ] ], testGroup - "Projection" - [ testProjectSingleColumn, - testProjectMultipleColumns, - testProjectWithExpression + "SQL99 featureset" + [ testGroup "CONCAT" [testConcat], + testGroup + "CTE" + [ testCommonTableExpression, + testMultipleCommonTableExpressions, + testRecursiveCommonTableExpression + ], + testGroup + "SOME/ANY/EVERY" + [ testSomeOver, + testAnyOver, + testEveryOver + ] ], testGroup - "Join" - [ testInnerJoin, - testMultiInnerJoin, - testMixingJoinsWithFilters, - testLeftJoin + "SQL2003 featureset" + [ testGroup + "Windowing" + [ testRowNumberOverWholeResult, + testRowNumberPartitionedByColumn, + testWindowingWithBounds + ], + testGroup + "LAG/LEAD" + [testLag, testLead], + testGroup + "FILTER" + [ testFilterWhereCountAll, + testFilterWithWindow + ], + testGroup + "FIRST_VALUE/LAST_VALUE" + [ testFirstValue, + testLastValue + ] ] ] @@ -242,6 +331,616 @@ nothingRows = filter (\(uid, _) -> uid `elem` map _userId usersWithoutOrders) results annotate "Users without orders should have Nothing quantity" mapM_ (\(_, mq) -> mq === Nothing) nothingRows + +-- TODO: this generates an invalid query +-- testCountDistinct :: TestTree +-- testCountDistinct = testCase "counts distinct users who placed orders" $ do +-- let users = [User 1 "Alice" 30] +-- withTestDb users [] [] $ \conn -> do +-- result <- +-- runBeamDuckDB conn $ +-- runSelectReturningList $ +-- select $ do +-- order <- all_ (_dbOrders testDb) +-- guard_ (distinct_ (pure $ _orderUserId order)) +-- pure order +-- result @?= [] + +testConcat :: TestTree +testConcat = testCase "CONCAT two columns" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + withTestDb users [] [] $ \conn -> do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + orderBy_ (asc_ . fst) $ + do + user <- all_ (_dbUsers testDb) + pure + ( _userId user, + concat_ + [ _userName user, + val_ " (age: ", + cast_ (_userAge user) (varchar Nothing), + val_ ")" + ] + ) + + map snd rows + @?= [ "Alice (age: 30)", + "Bob (age: 25)", + "Charlie (age: 35)" + ] + +testCommonTableExpression :: TestTree +testCommonTableExpression = testCase "Non-recursive common table expression" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + selectWith $ do + userTotals <- + selecting + $ aggregate_ + ( \o -> + ( group_ (_orderUserId o), + fromMaybe_ (val_ 0) $ sum_ (_orderQuantity o) + ) + ) + $ all_ (_dbOrders testDb) + + pure $ do + (uid, total) <- reuse userTotals + u <- filter_ (\u -> UserId (_userId u) ==. uid) $ all_ (_dbUsers testDb) + pure (_userName u, total) + + rows @?= [("Alice", 3), ("Bob", 1)] + +testMultipleCommonTableExpressions :: TestTree +testMultipleCommonTableExpressions = testCase "Multiple common table expressions" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + selectWith $ do + -- CTE 1: expensive products (price > 1000 cents) + expensiveProducts <- + selecting $ + filter_ (\p -> _productPrice p >. val_ 1000) $ + all_ (_dbProducts testDb) + + -- CTE 2: orders for expensive products + expensiveOrders <- + selecting $ do + p <- reuse expensiveProducts + filter_ (\o -> _orderProductId o `references_` p) $ + all_ (_dbOrders testDb) + + -- Main query: distinct users who ordered expensive products + pure $ do + o <- reuse expensiveOrders + u <- + filter_ (\u -> _orderUserId o `references_` u) $ + all_ (_dbUsers testDb) + pure (_userName u) + + -- Gadget costs 2999; Alice ordered it + nub rows @?= ["Alice"] + +testRecursiveCommonTableExpression :: TestTree +testRecursiveCommonTableExpression = testCase "Recursive common table expression" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + selectWith $ do + rec cte <- + selecting + -- Base case: SELECT 1 + ( pure (as_ @Int32 (val_ 1)) + `union_` + -- Recursive step: SELECT n + 1 FROM cte WHERE n < 5 + ( do + n <- reuse cte + guard_ (n <. val_ 5) + pure (n + val_ 1) + ) + ) + pure (reuse cte) + sort rows @?= [1, 2, 3, 4, 5 :: Int32] + +testSomeOver :: TestTree +testSomeOver = testCase "SOME" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + aggregate_ + ( \o -> + -- Expecting that at least one order per user has a quantity larger than 1 + -- This is only true of a single user, UserId 1 + ( group_ (_orderUserId o), + isTrue_ $ someOver_ allInGroup_ (sqlBool_ (_orderQuantity o >. val_ 1)) + ) + ) + (all_ (_dbOrders testDb)) + rows + @?= [ (UserId 1, True), + (UserId 2, False) + ] + +testAnyOver :: TestTree +testAnyOver = testCase "ANY" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + aggregate_ + ( \o -> + -- Expecting that at least one order per user has a quantity larger than 1 + -- This is only true of a single user, UserId 1 + ( group_ (_orderUserId o), + isTrue_ $ anyOver_ allInGroup_ (sqlBool_ (_orderQuantity o >. val_ 1)) + ) + ) + (all_ (_dbOrders testDb)) + rows + @?= [ (UserId 1, True), + (UserId 2, False) + ] + +testEveryOver :: TestTree +testEveryOver = testCase "EVERY" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + aggregate_ + ( \o -> + -- Expecting that all orders per user have a quantity larger than 1 + -- This is not true for any user + ( group_ (_orderUserId o), + isTrue_ $ everyOver_ allInGroup_ (sqlBool_ (_orderQuantity o >. val_ 1)) + ) + ) + (all_ (_dbOrders testDb)) + rows + @?= [ (UserId 1, False), + (UserId 2, False) + ] + +testRowNumberOverWholeResult :: TestTree +testRowNumberOverWholeResult = testCase "ROW_NUMBERS() over entire result set" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + withTestDb users [] [] $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + withWindow_ + (\_ -> frame_ noPartition_ noOrder_ noBounds_) + (\u w -> (_userName u, rowNumber_ `over_` w)) + (all_ (_dbUsers testDb)) + rows + @?= [ ("Alice", 1 :: Int32), + ("Bob", 2), + ("Charlie", 3) + ] + +testRowNumberPartitionedByColumn :: TestTree +testRowNumberPartitionedByColumn = testCase "ROW_NUMBERS() partitioned over column" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 3 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + orderBy_ (\(oid, _, _, _) -> asc_ oid) $ + withWindow_ + ( \o -> + frame_ + (partitionBy_ (_orderProductId o)) + (orderPartitionBy_ (desc_ (_orderQuantity o))) + noBounds_ + ) + (\o w -> (_orderId o, _orderProductId o, _orderUserId o, as_ @Int32 (rowNumber_ `over_` w))) + (all_ (_dbOrders testDb)) + -- We expect two groups of rows. + -- One group of rows for product ID 1, one group of rows for product ID 2. + -- For each group, the data for orders is considered in descending number of quantity + -- + -- the order of each group is not deterministic. + rows @?= [(1, ProductId 1, UserId 1, 1), (2, ProductId 1, UserId 2, 2), (3, ProductId 2, UserId 1, 1)] + +testWindowingWithBounds :: TestTree +testWindowingWithBounds = testCase "3-row moving average" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25 + ] + + products = + [Product 1 "Widget" 999] + orders = + [ Order 1 (UserId 1) (ProductId 1) 10, + Order 2 (UserId 1) (ProductId 1) 5, + Order 3 (UserId 2) (ProductId 1) 8, + Order 4 (UserId 1) (ProductId 1) 3, + Order 5 (UserId 2) (ProductId 1) 7 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + withWindow_ + ( \o -> + frame_ + noPartition_ + (orderPartitionBy_ (asc_ (_orderId o))) + (bounds_ (nrows_ 1) (Just (nrows_ 1))) + ) + ( \o w -> + ( _orderId o, + avgOver_ allInGroup_ (cast_ (_orderQuantity o) double) `over_` w + ) + ) + (all_ (_dbOrders testDb)) + rows + @?= [ (1, Just 7.5), + (2, Just 7.666666666666667), + (3, Just 5.333333333333333), + (4, Just 6.0), + (5, Just 5.0) + ] + +testLag :: TestTree +testLag = testCase "LAG" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 3 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + withWindow_ + (\o -> frame_ noPartition_ (orderPartitionBy_ (asc_ (_orderId o))) noBounds_) + ( \o w -> + lagWithDefault_ (_orderQuantity o) (val_ (1 :: Int32)) (val_ 0) `over_` w + ) + (all_ (_dbOrders testDb)) + -- First row has no predecessor → default 0 + -- Second row lags to first row's qty (2) + -- Third row lags to second row's qty (1) + rows @?= [0, 2, 1] + +testLead :: TestTree +testLead = testCase "LEAD" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 3 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + withWindow_ + (\o -> frame_ noPartition_ (orderPartitionBy_ (asc_ (_orderId o))) noBounds_) + ( \o w -> + lagWithDefault_ (_orderQuantity o) (val_ (1 :: Int32)) (val_ 0) `over_` w + ) + (all_ (_dbOrders testDb)) + -- First leads to second's qty (1) + -- Second leads to third's qty (1) + -- Third has no successor → default 0 + rows @?= [0, 2, 1] + +testFilterWhereCountAll :: TestTree +testFilterWhereCountAll = testCase "COUNT(*) FILTER (WHERE ... )" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 3 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn + $ runSelectReturningList + $ select + $ aggregate_ + ( \o -> + ( group_ (_orderUserId o), + as_ @Int32 $ countAll_, + as_ @Int32 $ countAll_ `filterWhere_` (_orderQuantity o >. val_ 1) + ) + ) + $ all_ (_dbOrders testDb) + -- Alice (uid 1): 2 total orders, 2 with qty > 1 + -- Bob (uid 2): 1 total order, 0 with qty > 1 + rows @?= [(UserId 1, 2, 2), (UserId 2, 1, 0)] + +testFilterWithWindow :: TestTree +testFilterWithWindow = testCase "FILTER with window function" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + withWindow_ + (\o -> frame_ noPartition_ (orderPartitionBy_ (asc_ (_orderId o))) noBounds_) + ( \o w -> + ( _orderId o, + fromMaybe_ + (val_ 0) + ( ( sumOver_ allInGroup_ (_orderQuantity o) + `filterWhere_` (_orderQuantity o >. val_ 1) + ) + `over_` w + ) + ) + ) + (all_ (_dbOrders testDb)) + -- Only order 1 (qty=2) passes the filter + -- Running filtered sum: 2, 2, 2 + let sorted = sort rows + map snd sorted @?= [2, 2, 2] + +testFirstValue :: TestTree +testFirstValue = testCase "FIRST_VALUE" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + orderBy_ (\(oid, _, _) -> desc_ oid) $ + withWindow_ + ( \o -> + frame_ + (partitionBy_ (_orderProductId o)) + (orderPartitionBy_ (asc_ (_orderQuantity o))) + (bounds_ unbounded_ (Just unbounded_)) + ) + ( \o w -> + ( _orderId o, + _orderProductId o, + firstValue_ (_orderQuantity o) `over_` w + ) + ) + (all_ (_dbOrders testDb)) + -- Widget (pid 1): quantities 1, 2 → first_value is 1 for both + -- Gadget (pid 2): quantity 1 → first_value is 1 + rows @?= [(3, ProductId 2, 1), (2, ProductId 1, 1), (1, ProductId 1, 1)] + +testLastValue :: TestTree +testLastValue = testCase "LAST_VALUE" $ do + let users = + [ User 1 "Alice" 30, + User 2 "Bob" 25, + User 3 "Charlie" 35 + ] + + products = + [ Product 1 "Widget" 999, + Product 2 "Gadget" 2999 + ] + orders = + [ Order 1 (UserId 1) (ProductId 1) 2, + Order 2 (UserId 2) (ProductId 1) 1, + Order 3 (UserId 1) (ProductId 2) 1 + ] + withTestDb users products orders $ \conn -> + do + rows <- + runBeamDuckDB conn $ + runSelectReturningList $ + select $ + orderBy_ (\(oid, _, _) -> asc_ oid) $ + withWindow_ + ( \o -> + frame_ + (partitionBy_ (_orderProductId o)) + (orderPartitionBy_ (asc_ (_orderQuantity o))) + -- Must use UNBOUNDED FOLLOWING to see the actual last value, + -- otherwise the default frame ends at CURRENT ROW. + (bounds_ unbounded_ (Just unbounded_)) + ) + ( \o w -> + ( _orderId o, + _orderProductId o, + lastValue_ (_orderQuantity o) `over_` w + ) + ) + (all_ (_dbOrders testDb)) + -- Widget (pid 1): quantities 1, 2 → last_value is 2 for both + rows @?= [(1, ProductId 1, 2), (2, ProductId 1, 2), (3, ProductId 2, 1)] data UserT f = User { _userId :: Columnar f Int32,