diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.0.0...main) +## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.1.0...main) + +## [v0.4.1.0](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.0.0...persistent-sql-lifted-v0.4.1.0) + +Add module `Database.Persist.Sql.Lifted.Expression.ArrayAggregate.PostgreSQL` ## [v0.4.0.0](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.3.0.0...persistent-sql-lifted-v0.4.0.0) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -23,8 +23,14 @@ - Instead of calling `runSqlPool` directly from the rest of your application code, use the `runSqlTx` method from the `MonadSqlTx` class. - [checkpointCallStack]: https://hackage.haskell.org/package/annotated-exception-0.3.0.2/docs/Control-Exception-Annotated-UnliftIO.html - [esqueleto]: https://hackage.haskell.org/package/esqueleto - [persistent]: https://hackage.haskell.org/package/persistent - [runSqlPool]: https://hackage.haskell.org/package/persistent-2.14.6.3/docs/Database-Persist-Sql.html#v:runSqlPool - [SqlPersistT]: https://hackage.haskell.org/package/persistent-2.14.6.3/docs/Database-Persist-Sql.html#t:SqlPersistT +For constructing SQL expressions, you may which to import the utilities from +`Database.Persist.Sql.Lifted.Expression` et al rather than getting them from +Esqueleto. This allows you to import the specific bits you need piecemeal and +without having to hide the unlifted versions of query-running functions that this +package replaces. Moreover, this package contains some additional utilities. + +[checkpointCallStack]: https://hackage.haskell.org/package/annotated-exception-0.3.0.2/docs/Control-Exception-Annotated-UnliftIO.html +[esqueleto]: https://hackage.haskell.org/package/esqueleto +[persistent]: https://hackage.haskell.org/package/persistent +[runSqlPool]: https://hackage.haskell.org/package/persistent-2.14.6.3/docs/Database-Persist-Sql.html#v:runSqlPool +[SqlPersistT]: https://hackage.haskell.org/package/persistent-2.14.6.3/docs/Database-Persist-Sql.html#t:SqlPersistT diff --git a/library/Database/Persist/Sql/Lifted/Expression/ArrayAggregate/PostgreSQL.hs b/library/Database/Persist/Sql/Lifted/Expression/ArrayAggregate/PostgreSQL.hs new file mode 100644 --- /dev/null +++ b/library/Database/Persist/Sql/Lifted/Expression/ArrayAggregate/PostgreSQL.hs @@ -0,0 +1,91 @@ +module Database.Persist.Sql.Lifted.Expression.ArrayAggregate.PostgreSQL + ( AggMode (..) + , arrayAggDistinct + , arrayAgg + , arrayAggWith + , arrayRemove + , arrayRemoveNull + , maybeArray + , arrayAggById + , arrayAggByIdMaybe + , arrayAggByMaybe + , arrayAggBy + ) where + +import Prelude + +import Database.Esqueleto.Experimental + ( Entity + , EntityField + , PersistEntity + , PersistField + , SqlExpr + , Value + , asc + , persistIdField + , (^.) + ) +import Database.Esqueleto.Internal.Internal + ( (??.) + ) +import Database.Esqueleto.PostgreSQL + ( AggMode (..) + , arrayAgg + , arrayAggDistinct + , arrayAggWith + , arrayRemove + , arrayRemoveNull + , maybeArray + ) + +-- | Aggregrate the given column with stable ordering (by ID) +-- +-- This ensures that if you aggregrate two columns: +-- +-- @ +-- pure +-- ( 'arrayAggById' students StudentFirstName +-- , 'arrayAggById' students StudentLastName +-- ) +-- @ +-- +-- The list, if zipped, will be as expected. +-- +-- See . +-- +-- Also replaces the 'Maybe' result with an empty list, because really that's +-- what you always want. +arrayAggById + :: (PersistEntity val, PersistField [typ], PersistField typ) + => SqlExpr (Entity val) + -> EntityField val typ + -> SqlExpr (Value [typ]) +arrayAggById es f = arrayAggBy (es ^. f) (es ^. persistIdField) + +-- | 'arrayAggById' but for a left-outer-joined entity +-- +-- If you're using '(?.)' instead of '(^.)', use this instead of 'arrayAggById'. +arrayAggByIdMaybe + :: (PersistEntity val, PersistField typ) + => SqlExpr (Maybe (Entity val)) + -> EntityField val typ + -> SqlExpr (Value [typ]) +arrayAggByIdMaybe es f = + arrayRemoveNull $ arrayAggBy (es ??. f) (es ??. persistIdField) + +-- | 'arrayAggBy' but for a left-outer-joined entity +-- +-- If you're using '(?.)' instead of '(^.)', use this instead of 'arrayAggBy'. +arrayAggByMaybe + :: (PersistField a, PersistField b) + => SqlExpr (Value (Maybe a)) + -> SqlExpr (Value b) + -> SqlExpr (Value [a]) +arrayAggByMaybe a = arrayRemoveNull . arrayAggBy a + +arrayAggBy + :: (PersistField [a], PersistField a, PersistField b) + => SqlExpr (Value a) + -> SqlExpr (Value b) + -> SqlExpr (Value [a]) +arrayAggBy a b = maybeArray $ arrayAggWith AggModeAll a [asc b] diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: persistent-sql-lifted -version: 0.4.0.0 +version: 0.4.1.0 maintainer: Freckle Education category: Database diff --git a/persistent-sql-lifted.cabal b/persistent-sql-lifted.cabal --- a/persistent-sql-lifted.cabal +++ b/persistent-sql-lifted.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: persistent-sql-lifted -version: 0.4.0.0 +version: 0.4.1.0 license: MIT license-file: LICENSE maintainer: Freckle Education @@ -36,6 +36,7 @@ Database.Persist.Sql.Lifted.Core Database.Persist.Sql.Lifted.Esqueleto Database.Persist.Sql.Lifted.Expression + Database.Persist.Sql.Lifted.Expression.ArrayAggregate.PostgreSQL Database.Persist.Sql.Lifted.Expression.Bool Database.Persist.Sql.Lifted.Expression.Case Database.Persist.Sql.Lifted.Expression.Comparison @@ -88,7 +89,7 @@ annotated-exception >=0.2.0.4, base >=4.16.4.0 && <5, containers >=0.6.5.1, - esqueleto >=3.5.10.0, + esqueleto >=3.6.0.0, mtl >=2.2.2, persistent >=2.14.5.0, text >=1.2.5.0,