pg-entity 0.0.2.0 → 0.0.3.0
raw patch · 9 files changed
+905/−810 lines, 9 filesdep ~basedep ~template-haskelldep ~timePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, template-haskell, time
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- pg-entity.cabal +3/−3
- src/Database/PostgreSQL/Entity.hs +442/−402
- src/Database/PostgreSQL/Entity/DBT.hs +105/−91
- src/Database/PostgreSQL/Entity/Internal.hs +217/−195
- src/Database/PostgreSQL/Entity/Internal/BlogPost.hs +23/−19
- src/Database/PostgreSQL/Entity/Internal/QQ.hs +29/−27
- src/Database/PostgreSQL/Entity/Internal/Unsafe.hs +24/−22
- src/Database/PostgreSQL/Entity/Types.hs +58/−51
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for Entity +## 0.0.3.0 -- 2022-10-30++* Fix compilation with resource-pool <0.3 (#51)+ ## 0.0.2.0 -- 2022-08-27 This is an experimental release
pg-entity.cabal view
@@ -5,7 +5,7 @@ A PostgreSQL layer to safely expand your SQL queries with a lightweight eDSL. Read the tutorial at https://tchoutri.github.io/pg-entity/Tutorial -version: 0.0.2.0+version: 0.0.3.0 homepage: https://tchoutri.github.io/pg-entity bug-reports: https://github.com/tchoutri/pg-entity/issues author: Théophile Choutri@@ -84,7 +84,7 @@ hs-source-dirs: src build-depends:- , base >=4.12 && <=4.18+ , base >=4.12 && <4.18.0 , bytestring ^>=0.11 , colourista ^>=0.1 , exceptions ^>=0.10@@ -94,7 +94,7 @@ , postgresql-simple ^>=0.6 , resource-pool ^>=0.3 , safe-exceptions ^>=0.1- , template-haskell >=2.15.0.0 && <=2.18.0.0+ , template-haskell >=2.15.0.0 && <2.18.0.0.0 , text ^>=2.0 , text-display ^>=0.0 , text-manipulate ^>=0.3
src/Database/PostgreSQL/Entity.hs view
@@ -1,17 +1,18 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE Strict #-} --- |--- Module : Database.PostgreSQL.Entity--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : stable------ A PostgreSQL database layer that does not get in your way.------ See the "Database.PostgreSQL.Entity.Internal.BlogPost" module for an example of a data-type implementing the 'Entity' typeclass.+{-|+ Module : Database.PostgreSQL.Entity+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : stable++ A PostgreSQL database layer that does not get in your way.++ See the "Database.PostgreSQL.Entity.Internal.BlogPost" module for an example of a data-type implementing the 'Entity' typeclass.+-} module Database.PostgreSQL.Entity ( -- * The /Entity/ Typeclass Entity (..)@@ -96,330 +97,356 @@ import Database.PostgreSQL.Entity.Internal import Database.PostgreSQL.Entity.Types --- $setup--- >>> :set -XQuasiQuotes--- >>> :set -XOverloadedStrings--- >>> :set -XOverloadedLists--- >>> :set -XTypeApplications--- >>> import Database.PostgreSQL.Entity--- >>> import Database.PostgreSQL.Entity.Types--- >>> import Database.PostgreSQL.Entity.Internal--- >>> import Database.PostgreSQL.Entity.Internal.BlogPost--- >>> import Database.PostgreSQL.Entity.Internal.QQ--- >>> import Database.PostgreSQL.Simple.Types (Query (..))--- >>> import Data.Vector (Vector)--- >>> import qualified Data.Vector as V+{- $setup+ >>> :set -XQuasiQuotes+ >>> :set -XOverloadedStrings+ >>> :set -XOverloadedLists+ >>> :set -XTypeApplications+ >>> import Database.PostgreSQL.Entity+ >>> import Database.PostgreSQL.Entity.Types+ >>> import Database.PostgreSQL.Entity.Internal+ >>> import Database.PostgreSQL.Entity.Internal.BlogPost+ >>> import Database.PostgreSQL.Entity.Internal.QQ+ >>> import Database.PostgreSQL.Simple.Types (Query (..))+ >>> import Data.Vector (Vector)+ >>> import qualified Data.Vector as V+-} --- $highlevel--- Glossary / Tips’n’Tricks------ * @e@, @e1@, @e2@: Represents an @Entity@--- * @value@: Represents a Haskell value that can be serialised to PostgreSQL--- * @Field@: Parameters of type @Field@ can most often be passed in their textual form inside the 'field' quasi-quoter,--- like @[field| author_id :: uuid|]@. This metaprogramming technique is here to better prevent empty fields from being passed.--- The PostgreSQL type annotation is optional, but necessary for arrays of UUIDs and of custom enums.------ Consult the [test suite](https://github.com/tchoutri/pg-entity/tree/main/test) to see those functions in action.+{- $highlevel+ Glossary / Tips’n’Tricks --- | Select an entity by its primary key.------ @since 0.0.1.0-selectById ::- forall e value m.- (Entity e, FromRow e, MonadIO m, ToRow value) =>- value ->- DBT m (Maybe e)+ * @e@, @e1@, @e2@: Represents an @Entity@+ * @value@: Represents a Haskell value that can be serialised to PostgreSQL+ * @Field@: Parameters of type @Field@ can most often be passed in their textual form inside the 'field' quasi-quoter,+ like @[field| author_id :: uuid|]@. This metaprogramming technique is here to better prevent empty fields from being passed.+ The PostgreSQL type annotation is optional, but necessary for arrays of UUIDs and of custom enums.++ Consult the [test suite](https://github.com/tchoutri/pg-entity/tree/main/test) to see those functions in action.+-}++{-| Select an entity by its primary key.++ @since 0.0.1.0+-}+selectById+ :: forall e value m+ . (Entity e, FromRow e, MonadIO m, ToRow value)+ => value+ -> DBT m (Maybe e) selectById value = selectOneByField (primaryKey @e) value --- | Select precisely __one__ entity by a provided field.------ @since 0.0.1.0-selectOneByField ::- forall e value m.- (Entity e, FromRow e, MonadIO m, ToRow value) =>- Field ->- value ->- DBT m (Maybe e)+{-| Select precisely __one__ entity by a provided field.++ @since 0.0.1.0+-}+selectOneByField+ :: forall e value m+ . (Entity e, FromRow e, MonadIO m, ToRow value)+ => Field+ -> value+ -> DBT m (Maybe e) selectOneByField f value = queryOne Select (_selectWhere @e [f]) value --- | Select potentially many entities by a provided field.------ @since 0.0.1.0-selectManyByField ::- forall e value m.- (Entity e, FromRow e, MonadIO m, ToRow value) =>- Field ->- value ->- DBT m (Vector e)+{-| Select potentially many entities by a provided field.++ @since 0.0.1.0+-}+selectManyByField+ :: forall e value m+ . (Entity e, FromRow e, MonadIO m, ToRow value)+ => Field+ -> value+ -> DBT m (Vector e) selectManyByField f value = query Select (_selectWhere @e [f]) value --- | Select statement with a non-null condition------ See '_selectWhereNotNull' for the generated query.------ @since 0.0.1.0-selectWhereNotNull ::- forall e m.- (Entity e, FromRow e, MonadIO m) =>- Vector Field ->- DBT m (Vector e)+{-| Select statement with a non-null condition++ See '_selectWhereNotNull' for the generated query.++ @since 0.0.1.0+-}+selectWhereNotNull+ :: forall e m+ . (Entity e, FromRow e, MonadIO m)+ => Vector Field+ -> DBT m (Vector e) selectWhereNotNull fs = query_ Select (_selectWhereNotNull @e fs) --- | Select statement with a null condition------ See '_selectWhereNull' for the generated query.------ @since 0.0.1.0-selectWhereNull ::- forall e m.- (Entity e, FromRow e, MonadIO m) =>- Vector Field ->- DBT m (Vector e)+{-| Select statement with a null condition++ See '_selectWhereNull' for the generated query.++ @since 0.0.1.0+-}+selectWhereNull+ :: forall e m+ . (Entity e, FromRow e, MonadIO m)+ => Vector Field+ -> DBT m (Vector e) selectWhereNull fs = query_ Select (_selectWhereNull @e fs) --- | Select statement when for an entity where the field is one of the options passed------ @since 0.0.2.0-selectOneWhereIn ::- forall e m.- (Entity e, FromRow e, MonadIO m) =>- Field ->- Vector Text ->- DBT m (Maybe e)+{-| Select statement when for an entity where the field is one of the options passed++ @since 0.0.2.0+-}+selectOneWhereIn+ :: forall e m+ . (Entity e, FromRow e, MonadIO m)+ => Field+ -> Vector Text+ -> DBT m (Maybe e) selectOneWhereIn f values = queryOne_ Select (_selectWhereIn @e f values) --- | Perform a INNER JOIN between two entities------ @since 0.0.1.0-joinSelectById ::- forall e1 e2 m.- (Entity e1, Entity e2, FromRow e1, MonadIO m) =>- DBT m (Vector e1)+{-| Perform a INNER JOIN between two entities++ @since 0.0.1.0+-}+joinSelectById+ :: forall e1 e2 m+ . (Entity e1, Entity e2, FromRow e1, MonadIO m)+ => DBT m (Vector e1) joinSelectById = query_ Select (_joinSelect @e1 @e2) --- | Perform a @INNER JOIN ON field1 WHERE field2 = value@ between two entities------ @since 0.0.2.0-joinSelectOneByField ::- forall e1 e2 value m.- (Entity e1, Entity e2, FromRow e1, MonadIO m, ToField value) =>- -- | The field over which the two tables will be joined- Field ->- -- | The field in the where clause- Field ->- -- | The value of the where clause- value ->- DBT m (Vector e1)+{-| Perform a @INNER JOIN ON field1 WHERE field2 = value@ between two entities++ @since 0.0.2.0+-}+joinSelectOneByField+ :: forall e1 e2 value m+ . (Entity e1, Entity e2, FromRow e1, MonadIO m, ToField value)+ => Field+ -- ^ The field over which the two tables will be joined+ -> Field+ -- ^ The field in the where clause+ -> value+ -- ^ The value of the where clause+ -> DBT m (Vector e1) joinSelectOneByField pivot whereClause value = query Select (_joinSelectOneByField @e1 @e2 pivot whereClause) (Only value) -- --- | Perform a SELECT + ORDER BY query on an entity------ @since 0.0.2.0-selectOrderBy ::- forall e m.- (Entity e, FromRow e, MonadIO m) =>- Vector (Field, SortKeyword) ->- DBT m (Vector e)+{-| Perform a SELECT + ORDER BY query on an entity++ @since 0.0.2.0+-}+selectOrderBy+ :: forall e m+ . (Entity e, FromRow e, MonadIO m)+ => Vector (Field, SortKeyword)+ -> DBT m (Vector e) selectOrderBy sortSpec = query_ Select (_select @e <> _orderByMany sortSpec) --- | Insert an entity.------ @since 0.0.1.0-insert ::- forall e values m.- (Entity e, ToRow values, MonadIO m) =>- values ->- DBT m ()+{-| Insert an entity.++ @since 0.0.1.0+-}+insert+ :: forall e values m+ . (Entity e, ToRow values, MonadIO m)+ => values+ -> DBT m () insert fs = void $ execute Insert (_insert @e) fs --- | Insert an entity with a "ON CONFLICT DO UPDATE" clause on the primary key as the conflict target------ @since 0.0.2.0-upsert ::- forall e values m.- (Entity e, ToRow values, MonadIO m) =>- -- | Entity to insert- values ->- -- | Fields to replace in case of conflict- Vector Field ->- DBT m ()+{-| Insert an entity with a "ON CONFLICT DO UPDATE" clause on the primary key as the conflict target++ @since 0.0.2.0+-}+upsert+ :: forall e values m+ . (Entity e, ToRow values, MonadIO m)+ => values+ -- ^ Entity to insert+ -> Vector Field+ -- ^ Fields to replace in case of conflict+ -> DBT m () upsert entity fieldsToReplace = void $ execute Insert (_insert @e <> _onConflictDoUpdate conflictTarget fieldsToReplace) entity where conflictTarget = V.singleton $ primaryKey @e --- | Insert multiple rows of an entity.------ @since 0.0.2.0-insertMany ::- forall e values m.- (Entity e, ToRow values, MonadIO m) =>- [values] ->- DBT m ()+{-| Insert multiple rows of an entity.++ @since 0.0.2.0+-}+insertMany+ :: forall e values m+ . (Entity e, ToRow values, MonadIO m)+ => [values]+ -> DBT m () insertMany values = void $ executeMany Insert (_insert @e) values --- | Update an entity.------ The Id of the entity is put at the end of the query automatically through the use of 'UpdateRow'.--- __Examples__------ > let newAuthor = oldAuthor{…}--- > update @Author newAuthor------ @since 0.0.1.0-update ::- forall e newValue m.- (Entity e, ToRow newValue, MonadIO m) =>- newValue ->- DBT m ()+{-| Update an entity.++ The Id of the entity is put at the end of the query automatically through the use of 'UpdateRow'.+ __Examples__++ > let newAuthor = oldAuthor{…}+ > update @Author newAuthor++ @since 0.0.1.0+-}+update+ :: forall e newValue m+ . (Entity e, ToRow newValue, MonadIO m)+ => newValue+ -> DBT m () update fs = void $ execute Update (_update @e) (UpdateRow fs) --- | Update rows of an entity matching the given value------ == Example------ > let newName = "Tiberus McElroy" :: Text--- > let oldName = "Johnson McElroy" :: Text--- > updateFieldsBy @Author [[field| name |]] ([field| name |], oldName) (Only newName)------ @since 0.0.1.0-updateFieldsBy ::- forall e v1 v2 m.- (Entity e, MonadIO m, ToRow v2, ToField v1) =>- -- | Fields to change- Vector Field ->- -- | Field on which to match and its value- (Field, v1) ->- -- | New values of those fields- v2 ->- DBT m Int64+{-| Update rows of an entity matching the given value++ == Example++ > let newName = "Tiberus McElroy" :: Text+ > let oldName = "Johnson McElroy" :: Text+ > updateFieldsBy @Author [[field| name |]] ([field| name |], oldName) (Only newName)++ @since 0.0.1.0+-}+updateFieldsBy+ :: forall e v1 v2 m+ . (Entity e, MonadIO m, ToRow v2, ToField v1)+ => Vector Field+ -- ^ Fields to change+ -> (Field, v1)+ -- ^ Field on which to match and its value+ -> v2+ -- ^ New values of those fields+ -> DBT m Int64 updateFieldsBy fs (f, oldValue) newValue = execute Update (_updateFieldsBy @e fs f) (toRow newValue ++ toRow (Only oldValue)) --- | Delete an entity according to its primary key.------ @since 0.0.1.0-delete ::- forall e value m.- (Entity e, ToRow value, MonadIO m) =>- value ->- DBT m ()+{-| Delete an entity according to its primary key.++ @since 0.0.1.0+-}+delete+ :: forall e value m+ . (Entity e, ToRow value, MonadIO m)+ => value+ -> DBT m () delete value = deleteByField @e [primaryKey @e] value --- | Delete rows according to the given fields------ == Example------ > deleteByField @BlogPost [[field| title |]] (Only "Echoes from the other world")------ @since 0.0.1.0-deleteByField ::- forall e values m.- (Entity e, ToRow values, MonadIO m) =>- Vector Field ->- values ->- DBT m ()+{-| Delete rows according to the given fields++ == Example++ > deleteByField @BlogPost [[field| title |]] (Only "Echoes from the other world")++ @since 0.0.1.0+-}+deleteByField+ :: forall e values m+ . (Entity e, ToRow values, MonadIO m)+ => Vector Field+ -> values+ -> DBT m () deleteByField fs values = void $ execute Delete (_deleteWhere @e fs) values -- * SQL combinators API --- | Produce a SELECT statement for a given entity.------ __Examples__------ >>> _select @BlogPost--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\""------ @since 0.0.1.0+{-| Produce a SELECT statement for a given entity.++ __Examples__++ >>> _select @BlogPost+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\""++ @since 0.0.1.0+-} _select :: forall e. Entity e => Query _select = textToQuery $ "SELECT " <> expandQualifiedFields @e <> " FROM " <> getTableName @e --- | Produce a SELECT statement with explicit fields for a given entity------ __Examples__------ >>> _selectWithFields @BlogPost [ [field| blogpost_id |], [field| created_at |] ]--- "SELECT \"blogposts\".\"blogpost_id\", \"blogposts\".\"created_at\" FROM \"\"blogposts\"\""------ @since 0.0.1.0+{-| Produce a SELECT statement with explicit fields for a given entity++ __Examples__++ >>> _selectWithFields @BlogPost [ [field| blogpost_id |], [field| created_at |] ]+ "SELECT \"blogposts\".\"blogpost_id\", \"blogposts\".\"created_at\" FROM \"\"blogposts\"\""++ @since 0.0.1.0+-} _selectWithFields :: forall e. Entity e => Vector Field -> Query _selectWithFields fs = textToQuery $ "SELECT " <> expandQualifiedFields' fs tn <> " FROM " <> quoteName tn where tn = getTableName @e --- | Produce a WHERE clause, given a vector of fields.------ It is most useful composed with a '_select' or '_delete', which is why these two combinations have their dedicated functions,--- but the user is free to compose their own queries.------ The 'Entity' constraint is required for '_where' in order to get any type annotation that was given in the schema.--- Fields that do not exist in the Entity will be kept so that PostgreSQL can report the error.------ __Examples__------ >>> _select @BlogPost <> _where @BlogPost [[field| blogpost_id |]]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"blogpost_id\" = ?"------ >>> _select @BlogPost <> _where @BlogPost [ [field| uuid_list |] ]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"uuid_list\" = ?"------ @since 0.0.1.0+{-| Produce a WHERE clause, given a vector of fields.++ It is most useful composed with a '_select' or '_delete', which is why these two combinations have their dedicated functions,+ but the user is free to compose their own queries.++ The 'Entity' constraint is required for '_where' in order to get any type annotation that was given in the schema.+ Fields that do not exist in the Entity will be kept so that PostgreSQL can report the error.++ __Examples__++ >>> _select @BlogPost <> _where [[field| blogpost_id |]]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"blogpost_id\" = ?"++ >>> _select @BlogPost <> _where [ [field| uuid_list |] ]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"uuid_list\" = ?"++ @since 0.0.1.0+-} _where :: Vector Field -> Query _where fs' = textToQuery $ " WHERE " <> clauseFields where clauseFields = fold $ intercalateVector " AND " (fmap placeholder fs') --- | Produce a SELECT statement for a given entity and fields.------ __Examples__------ >>> _selectWhere @BlogPost [ [field| author_id |] ]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" = ?"------ >>> _selectWhere @BlogPost [ [field| author_id |], [field| title |]]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" = ? AND \"title\" = ?"------ @since 0.0.1.0+{-| Produce a SELECT statement for a given entity and fields.++ __Examples__++ >>> _selectWhere @BlogPost [ [field| author_id |] ]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" = ?"++ >>> _selectWhere @BlogPost [ [field| author_id |], [field| title |]]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" = ? AND \"title\" = ?"++ @since 0.0.1.0+-} _selectWhere :: forall e. Entity e => Vector Field -> Query _selectWhere fs = _select @e <> _where fs --- | Produce a SELECT statement where the provided fields are checked for being non-null.--- r------ >>> _selectWhereNotNull @BlogPost [ [field| author_id |] ]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" IS NOT NULL"------ @since 0.0.1.0+{-| Produce a SELECT statement where the provided fields are checked for being non-null.+ r++ >>> _selectWhereNotNull @BlogPost [ [field| author_id |] ]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" IS NOT NULL"++ @since 0.0.1.0+-} _selectWhereNotNull :: forall e. Entity e => Vector Field -> Query _selectWhereNotNull fs = _select @e <> textToQuery (" WHERE " <> isNotNull fs) --- | Produce a SELECT statement where the provided fields are checked for being null.------ >>> _selectWhereNull @BlogPost [ [field| author_id |] ]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" IS NULL"------ @since 0.0.1.0+{-| Produce a SELECT statement where the provided fields are checked for being null.++ >>> _selectWhereNull @BlogPost [ [field| author_id |] ]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"author_id\" IS NULL"++ @since 0.0.1.0+-} _selectWhereNull :: forall e. Entity e => Vector Field -> Query _selectWhereNull fs = _select @e <> textToQuery (" WHERE " <> isNull fs) --- | Produce a SELECT statement where the given field is checked aginst the provided array of values .------ >>> _selectWhereIn @BlogPost [field| title |] [ "Unnamed", "Mordred's Song" ]--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"title\" IN ('Unnamed', 'Mordred''s Song')"------ @since 0.0.2.0+{-| Produce a SELECT statement where the given field is checked aginst the provided array of values .++ >>> _selectWhereIn @BlogPost [field| title |] [ "Unnamed", "Mordred's Song" ]+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" WHERE \"title\" IN ('Unnamed', 'Mordred''s Song')"++ @since 0.0.2.0+-} _selectWhereIn :: forall e. Entity e => Field -> Vector Text -> Query _selectWhereIn f values = _select @e <> textToQuery (" WHERE " <> isIn f values) --- | Produce a "SELECT FROM" over two entities.------ __Examples__------ >>> _joinSelect @BlogPost @Author--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\", authors.\"author_id\", authors.\"name\", authors.\"created_at\" FROM \"blogposts\" INNER JOIN \"authors\" USING(author_id)"------ @since 0.0.1.0+{-| Produce a "SELECT FROM" over two entities.++ __Examples__++ >>> _joinSelect @BlogPost @Author+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\", authors.\"author_id\", authors.\"name\", authors.\"created_at\" FROM \"blogposts\" INNER JOIN \"authors\" USING(author_id)"++ @since 0.0.1.0+-} _joinSelect :: forall e1 e2. (Entity e1, Entity e2) => Query _joinSelect = textToQuery $@@ -431,14 +458,15 @@ <> getTableName @e1 <> queryToText (_innerJoin @e2 (primaryKey @e2)) --- | Produce a "INNER JOIN … USING(…)" fragment.------ __Examples__------ >>> _innerJoin @BlogPost [field| author_id |]--- " INNER JOIN \"blogposts\" USING(author_id)"------ @since 0.0.1.0+{-| Produce a "INNER JOIN … USING(…)" fragment.++ __Examples__++ >>> _innerJoin @BlogPost [field| author_id |]+ " INNER JOIN \"blogposts\" USING(author_id)"++ @since 0.0.1.0+-} _innerJoin :: forall e. (Entity e) => Field -> Query _innerJoin f = textToQuery $@@ -448,21 +476,22 @@ <> fieldName f <> ")" --- | Produce a "SELECT [table1_fields, table2_fields] FROM table1 INNER JOIN table2 USING(table2_pk)" statement.--- The primary is used as the join point between the two tables.------ __Examples__------ >>> _joinSelectWithFields @BlogPost @Author [ [field| title |] ] [ [field| name |] ]--- "SELECT \"blogposts\".\"title\", \"authors\".\"name\" FROM \"blogposts\" INNER JOIN \"authors\" USING(author_id)"------ @since 0.0.1.0-_joinSelectWithFields ::- forall e1 e2.- (Entity e1, Entity e2) =>- Vector Field ->- Vector Field ->- Query+{-| Produce a "SELECT [table1_fields, table2_fields] FROM table1 INNER JOIN table2 USING(table2_pk)" statement.+ The primary is used as the join point between the two tables.++ __Examples__++ >>> _joinSelectWithFields @BlogPost @Author [ [field| title |] ] [ [field| name |] ]+ "SELECT \"blogposts\".\"title\", \"authors\".\"name\" FROM \"blogposts\" INNER JOIN \"authors\" USING(author_id)"++ @since 0.0.1.0+-}+_joinSelectWithFields+ :: forall e1 e2+ . (Entity e1, Entity e2)+ => Vector Field+ -> Vector Field+ -> Query _joinSelectWithFields fs1 fs2 = textToQuery $ "SELECT "@@ -476,20 +505,21 @@ tn1 = getTableName @e1 tn2 = getTableName @e2 --- | Produce a "SELECT FROM" over two entities.------ __Examples__------ >>> _joinSelectOneByField @BlogPost @Author [field| author_id |] [field| name |] :: Query--- "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" INNER JOIN \"authors\" ON \"blogposts\".\"author_id\" = \"authors\".\"author_id\" WHERE authors.\"name\" = ?"------ @since 0.0.2.0-_joinSelectOneByField ::- forall e1 e2.- (Entity e1, Entity e2) =>- Field ->- Field ->- Query+{-| Produce a "SELECT FROM" over two entities.++ __Examples__++ >>> _joinSelectOneByField @BlogPost @Author [field| author_id |] [field| name |] :: Query+ "SELECT blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\" FROM \"blogposts\" INNER JOIN \"authors\" ON \"blogposts\".\"author_id\" = \"authors\".\"author_id\" WHERE authors.\"name\" = ?"++ @since 0.0.2.0+-}+_joinSelectOneByField+ :: forall e1 e2+ . (Entity e1, Entity e2)+ => Field+ -> Field+ -> Query _joinSelectOneByField pivotField whereField = textToQuery $ "SELECT "@@ -509,34 +539,36 @@ <> " WHERE " <> placeholder' @e2 whereField --- | Produce an INSERT statement for the given entity.------ __Examples__------ >>> _insert @BlogPost--- "INSERT INTO \"blogposts\" (\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") VALUES (?, ?, ?, ?, ?, ?)"------ @since 0.0.1.0+{-| Produce an INSERT statement for the given entity.++ __Examples__++ >>> _insert @BlogPost+ "INSERT INTO \"blogposts\" (\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") VALUES (?, ?, ?, ?, ?, ?)"++ @since 0.0.1.0+-} _insert :: forall e. Entity e => Query _insert = textToQuery $ "INSERT INTO " <> getTableName @e <> " " <> fs <> " VALUES " <> ps where fs = inParens (expandFields @e) ps = inParens (generatePlaceholders $ fields @e) --- | Produce a "ON CONFLICT (target) DO UPDATE SET …" statement.------ __Examples__------ >>> _onConflictDoUpdate [[field| blogpost_id |]] [ [field| title |], [field| content |]]--- " ON CONFLICT (blogpost_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"------ >>> _onConflictDoUpdate [[field| blogpost_id |], [field| author_id |]] [ [field| title |], [field| content |]]--- " ON CONFLICT (blogpost_id, author_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"------ >>> _insert @BlogPost <> _onConflictDoUpdate [[field| blogpost_id |]] [ [field| title |], [field| content |]]--- "INSERT INTO \"blogposts\" (\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") VALUES (?, ?, ?, ?, ?, ?) ON CONFLICT (blogpost_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"------ @since 0.0.2.0+{-| Produce a "ON CONFLICT (target) DO UPDATE SET …" statement.++ __Examples__++ >>> _onConflictDoUpdate [[field| blogpost_id |]] [ [field| title |], [field| content |]]+ " ON CONFLICT (blogpost_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"++ >>> _onConflictDoUpdate [[field| blogpost_id |], [field| author_id |]] [ [field| title |], [field| content |]]+ " ON CONFLICT (blogpost_id, author_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"++ >>> _insert @BlogPost <> _onConflictDoUpdate [[field| blogpost_id |]] [ [field| title |], [field| content |]]+ "INSERT INTO \"blogposts\" (\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") VALUES (?, ?, ?, ?, ?, ?) ON CONFLICT (blogpost_id) DO UPDATE SET title = EXCLUDED.title, content = EXCLUDED.content"++ @since 0.0.2.0+-} _onConflictDoUpdate :: Vector Field -> Vector Field -> Query _onConflictDoUpdate conflictTarget fieldsToReplace = textToQuery $ " ON CONFLICT (" <> targetNames <> ") DO UPDATE SET " <> replacedFields@@ -546,57 +578,61 @@ replaceField :: Text -> Text replaceField f = f <> " = EXCLUDED." <> f --- | Produce an UPDATE statement for the given entity by primary key------ __Examples__------ >>> _update @Author--- "UPDATE \"authors\" SET (\"name\", \"created_at\") = ROW(?, ?) WHERE \"author_id\" = ?"------ >>> _update @BlogPost--- "UPDATE \"blogposts\" SET (\"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") = ROW(?, ?, ?, ?, ?) WHERE \"blogpost_id\" = ?"------ @since 0.0.1.0+{-| Produce an UPDATE statement for the given entity by primary key++ __Examples__++ >>> _update @Author+ "UPDATE \"authors\" SET (\"name\", \"created_at\") = ROW(?, ?) WHERE \"author_id\" = ?"++ >>> _update @BlogPost+ "UPDATE \"blogposts\" SET (\"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\") = ROW(?, ?, ?, ?, ?) WHERE \"blogpost_id\" = ?"++ @since 0.0.1.0+-} _update :: forall e. Entity e => Query _update = _updateBy @e (primaryKey @e) --- | Produce an UPDATE statement for the given entity by the given field.------ __Examples__------ >>> _updateBy @Author [field| name |]--- "UPDATE \"authors\" SET (\"name\", \"created_at\") = ROW(?, ?) WHERE \"name\" = ?"------ @since 0.0.1.0+{-| Produce an UPDATE statement for the given entity by the given field.++ __Examples__++ >>> _updateBy @Author [field| name |]+ "UPDATE \"authors\" SET (\"name\", \"created_at\") = ROW(?, ?) WHERE \"name\" = ?"++ @since 0.0.1.0+-} _updateBy :: forall e. Entity e => Field -> Query _updateBy f = _updateFieldsBy @e (fields @e) f --- | Produce an UPDATE statement for the given entity and fields, by primary key.------ >>> _updateFields @Author [ [field| name |] ]--- "UPDATE \"authors\" SET (\"name\") = ROW(?) WHERE \"author_id\" = ?"------ @since 0.0.1.0+{-| Produce an UPDATE statement for the given entity and fields, by primary key.++ >>> _updateFields @Author [ [field| name |] ]+ "UPDATE \"authors\" SET (\"name\") = ROW(?) WHERE \"author_id\" = ?"++ @since 0.0.1.0+-} _updateFields :: forall e. Entity e => Vector Field -> Query _updateFields fs = _updateFieldsBy @e fs (primaryKey @e) --- | Produce an UPDATE statement for the given entity and fields, by the specified field.------ >>> _updateFieldsBy @Author [ [field| name |] ] [field| name |]--- "UPDATE \"authors\" SET (\"name\") = ROW(?) WHERE \"name\" = ?"------ >>> _updateFieldsBy @BlogPost [[field| author_id |], [field| title |]] [field| title |]--- "UPDATE \"blogposts\" SET (\"author_id\", \"title\") = ROW(?, ?) WHERE \"title\" = ?"------ @since 0.0.1.0-_updateFieldsBy ::- forall e.- Entity e =>- -- | Field names to update- Vector Field ->- -- | Field on which to match- Field ->- Query+{-| Produce an UPDATE statement for the given entity and fields, by the specified field.++ >>> _updateFieldsBy @Author [ [field| name |] ] [field| name |]+ "UPDATE \"authors\" SET (\"name\") = ROW(?) WHERE \"name\" = ?"++ >>> _updateFieldsBy @BlogPost [[field| author_id |], [field| title |]] [field| title |]+ "UPDATE \"blogposts\" SET (\"author_id\", \"title\") = ROW(?, ?) WHERE \"title\" = ?"++ @since 0.0.1.0+-}+_updateFieldsBy+ :: forall e+ . Entity e+ => Vector Field+ -- ^ Field names to update+ -> Field+ -- ^ Field on which to match+ -> Query _updateFieldsBy fs' f = textToQuery ( "UPDATE "@@ -614,46 +650,50 @@ inParens $ V.foldl1' (\element acc -> element <> ", " <> acc) (quoteName . fieldName <$> fs) --- | Produce a DELETE statement for the given entity, with a match on the Primary Key------ __Examples__------ >>> _delete @BlogPost--- "DELETE FROM \"blogposts\" WHERE \"blogpost_id\" = ?"------ @since 0.0.1.0+{-| Produce a DELETE statement for the given entity, with a match on the Primary Key++ __Examples__++ >>> _delete @BlogPost+ "DELETE FROM \"blogposts\" WHERE \"blogpost_id\" = ?"++ @since 0.0.1.0+-} _delete :: forall e. Entity e => Query _delete = textToQuery ("DELETE FROM " <> getTableName @e) <> _where [primaryKey @e] --- | Produce a DELETE statement for the given entity and fields------ __Examples__------ >>> _deleteWhere @BlogPost [[field| title |], [field| created_at |]]--- "DELETE FROM \"blogposts\" WHERE \"title\" = ? AND \"created_at\" = ?"------ @since 0.0.1.0+{-| Produce a DELETE statement for the given entity and fields++ __Examples__++ >>> _deleteWhere @BlogPost [[field| title |], [field| created_at |]]+ "DELETE FROM \"blogposts\" WHERE \"title\" = ? AND \"created_at\" = ?"++ @since 0.0.1.0+-} _deleteWhere :: forall e. Entity e => Vector Field -> Query _deleteWhere fs = textToQuery ("DELETE FROM " <> (getTableName @e)) <> _where fs --- | Produce an ORDER BY clause with one field and a sorting keyword------ __Examples__------ >>> _orderBy ([field| title |], ASC)--- " ORDER BY \"title\" ASC"------ @since 0.0.2.0+{-| Produce an ORDER BY clause with one field and a sorting keyword++ __Examples__++ >>> _orderBy ([field| title |], ASC)+ " ORDER BY \"title\" ASC"++ @since 0.0.2.0+-} _orderBy :: (Field, SortKeyword) -> Query _orderBy (f, sort) = textToQuery (" ORDER BY " <> quoteName (fieldName f) <> " " <> display sort) --- | Produce an ORDER BY clause with many fields and sorting keywords------ __Examples__------ >>> _orderByMany (V.fromList [([field| title |], ASC), ([field| created_at |], DESC)])--- " ORDER BY \"title\" ASC, \"created_at\" DESC"------ @since 0.0.2.0+{-| Produce an ORDER BY clause with many fields and sorting keywords++ __Examples__++ >>> _orderByMany (V.fromList [([field| title |], ASC), ([field| created_at |], DESC)])+ " ORDER BY \"title\" ASC, \"created_at\" DESC"++ @since 0.0.2.0+-} _orderByMany :: Vector (Field, SortKeyword) -> Query _orderByMany sortExpressions = textToQuery $ " ORDER BY " <> fold (intercalateVector ", " $ fmap renderSortExpression sortExpressions)
src/Database/PostgreSQL/Entity/DBT.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE CPP #-} --- |--- Module : Database.PostgreSQL.Entity.DBT--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : stable------ The 'Database.PostgreSQL.Transact.DBT' plumbing module to handle database queries and pools+{-|+ Module : Database.PostgreSQL.Entity.DBT+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : stable++ The 'Database.PostgreSQL.Transact.DBT' plumbing module to handle database queries and pools+-} module Database.PostgreSQL.Entity.DBT ( mkPool , withPool@@ -31,6 +32,10 @@ #endif import Control.Monad.IO.Class+#if MIN_VERSION_resource_pool(0,3,0)+#else+import Control.Monad.Trans.Control+#endif import Data.Int import Data.Maybe (listToMaybe) import Data.Pool (Pool, createPool, withResource)@@ -41,35 +46,37 @@ import Database.PostgreSQL.Simple as PG (ConnectInfo, Connection, FromRow, Query, ToRow, close, connect) import qualified Database.PostgreSQL.Transact as PGT --- | Create a Pool Connection with the appropriate parameters------ @since 0.0.1.0-mkPool ::- ConnectInfo -> -- Database access information- Int -> -- Number of sub-pools- NominalDiffTime -> -- Allowed timeout- Int -> -- Number of connections- IO (Pool Connection)+{-| Create a Pool Connection with the appropriate parameters++ @since 0.0.1.0+-}+mkPool+ :: ConnectInfo -- Database access information+ -> Int -- Number of sub-pools+ -> NominalDiffTime -- Allowed timeout+ -> Int -- Number of connections+ -> IO (Pool Connection) mkPool connectInfo subPools timeout connections = createPool (connect connectInfo) close subPools timeout connections --- | Run a DBT action with no explicit error handling.------ This functions is suited for using 'MonadError' error handling.------ === __Example__------ > let e1 = E 1 True True--- > result <- runExceptT @EntityError $ do--- > withPool pool $ insertEntity e1--- > withPool pool $ markForProcessing 1--- > case result of--- > Left err -> print err--- > Right _ -> putStrLn "Everything went well"------ See the code in the @example/@ directory on GitHub------ @since 0.0.1.0+{-| Run a DBT action with no explicit error handling.++ This functions is suited for using 'MonadError' error handling.++ === __Example__++ > let e1 = E 1 True True+ > result <- runExceptT @EntityError $ do+ > withPool pool $ insertEntity e1+ > withPool pool $ markForProcessing 1+ > case result of+ > Left err -> print err+ > Right _ -> putStrLn "Everything went well"++ See the code in the @example/@ directory on GitHub++ @since 0.0.1.0+-} #if MIN_VERSION_resource_pool(0,3,0) withPool :: (MonadIO m) => Pool Connection -> PGT.DBT IO a -> m a withPool pool action = liftIO $ withResource pool (\conn -> PGT.runDBTSerializable action conn)@@ -78,80 +85,86 @@ withPool pool action = withResource pool (\conn -> PGT.runDBTSerializable action conn) #endif --- | Query wrapper that returns a 'Vector' of results------ @since 0.0.1.0-query ::- (ToRow params, FromRow result, MonadIO m) =>- QueryNature ->- Query ->- params ->- PGT.DBT m (Vector result)+{-| Query wrapper that returns a 'Vector' of results++ @since 0.0.1.0+-}+query+ :: (ToRow params, FromRow result, MonadIO m)+ => QueryNature+ -> Query+ -> params+ -> PGT.DBT m (Vector result) query queryNature q params = do logQueryFormat queryNature q params V.fromList <$> PGT.query q params --- | Query wrapper that returns a 'Vector' of results and does not take an argument------ @since 0.0.1.0-query_ ::- (FromRow result, MonadIO m) =>- QueryNature ->- Query ->- PGT.DBT m (Vector result)+{-| Query wrapper that returns a 'Vector' of results and does not take an argument++ @since 0.0.1.0+-}+query_+ :: (FromRow result, MonadIO m)+ => QueryNature+ -> Query+ -> PGT.DBT m (Vector result) query_ queryNature q = do logQueryFormat queryNature q () V.fromList <$> PGT.query_ q --- | Query wrapper that returns one result.------ @since 0.0.1.0-queryOne ::- (ToRow params, FromRow result, MonadIO m) =>- QueryNature ->- Query ->- params ->- PGT.DBT m (Maybe result)+{-| Query wrapper that returns one result.++ @since 0.0.1.0+-}+queryOne+ :: (ToRow params, FromRow result, MonadIO m)+ => QueryNature+ -> Query+ -> params+ -> PGT.DBT m (Maybe result) queryOne queryNature q params = do logQueryFormat queryNature q params listToMaybe <$> PGT.query q params -- --- | Query wrapper that returns one result and does not take an argument------ @since 0.0.2.0-queryOne_ ::- (FromRow result, MonadIO m) =>- QueryNature ->- Query ->- PGT.DBT m (Maybe result)+{-| Query wrapper that returns one result and does not take an argument++ @since 0.0.2.0+-}+queryOne_+ :: (FromRow result, MonadIO m)+ => QueryNature+ -> Query+ -> PGT.DBT m (Maybe result) queryOne_ queryNature q = do logQueryFormat queryNature q () listToMaybe <$> PGT.query_ q --- | Query wrapper for SQL statements which do not return.------ @since 0.0.1.0-execute ::- (ToRow params, MonadIO m) =>- QueryNature ->- Query ->- params ->- PGT.DBT m Int64+{-| Query wrapper for SQL statements which do not return.++ @since 0.0.1.0+-}+execute+ :: (ToRow params, MonadIO m)+ => QueryNature+ -> Query+ -> params+ -> PGT.DBT m Int64 execute queryNature q params = do logQueryFormat queryNature q params PGT.execute q params --- | Query wrapper for SQL statements that operate on multiple rows which do not return.------ @since 0.0.2.0-executeMany ::- (ToRow params, MonadIO m) =>- QueryNature ->- Query ->- [params] ->- PGT.DBT m Int64+{-| Query wrapper for SQL statements that operate on multiple rows which do not return.++ @since 0.0.2.0+-}+executeMany+ :: (ToRow params, MonadIO m)+ => QueryNature+ -> Query+ -> [params]+ -> PGT.DBT m Int64 executeMany queryNature q params = do logQueryFormatMany queryNature q params PGT.executeMany q params@@ -188,8 +201,9 @@ formatMany q xs = PGT.getConnection >>= \conn -> liftIO $ Simple.formatMany conn q xs #endif --- | This sum type is given to the 'query', 'queryOne' and 'execute' functions to help--- with logging.------ @since 0.0.1.0+{-| This sum type is given to the 'query', 'queryOne' and 'execute' functions to help+ with logging.++ @since 0.0.1.0+-} data QueryNature = Select | Insert | Update | Delete deriving (Eq, Show)
src/Database/PostgreSQL/Entity/Internal.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE Strict #-} --- |--- Module : Database.PostgreSQL.Entity.Internal--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : stable------ Internal helpers used to implement the high-level API and SQL combinators.------ You can re-use those building blocks freely to create your own wrappers.+{-|+ Module : Database.PostgreSQL.Entity.Internal+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : stable++ Internal helpers used to implement the high-level API and SQL combinators.++ You can re-use those building blocks freely to create your own wrappers.+-} module Database.PostgreSQL.Entity.Internal ( -- * Helpers isNotNull@@ -51,121 +52,131 @@ import Database.PostgreSQL.Entity.Internal.Unsafe (Field (Field)) import Database.PostgreSQL.Entity.Types --- $setup--- >>> :set -XQuasiQuotes--- >>> :set -XOverloadedLists--- >>> :set -XTypeApplications--- >>> import Database.PostgreSQL.Entity--- >>> import Database.PostgreSQL.Entity.Types--- >>> import Database.PostgreSQL.Entity.Internal.BlogPost--- >>> import Database.PostgreSQL.Entity.Internal.QQ--- >>> import Database.PostgreSQL.Entity.Internal.Unsafe+{- $setup+ >>> :set -XQuasiQuotes+ >>> :set -XOverloadedLists+ >>> :set -XTypeApplications+ >>> import Database.PostgreSQL.Entity+ >>> import Database.PostgreSQL.Entity.Types+ >>> import Database.PostgreSQL.Entity.Internal.BlogPost+ >>> import Database.PostgreSQL.Entity.Internal.QQ+ >>> import Database.PostgreSQL.Entity.Internal.Unsafe+-} --- | Wrap the given text between parentheses------ __Examples__------ >>> inParens "wrap me!"--- "(wrap me!)"------ @since 0.0.1.0+{-| Wrap the given text between parentheses++ __Examples__++ >>> inParens "wrap me!"+ "(wrap me!)"++ @since 0.0.1.0+-} inParens :: Text -> Text inParens t = "(" <> t <> ")" --- | Wrap the given text between double quotes------ __Examples__------ >>> quoteName "meow."--- "\"meow.\""------ @since 0.0.1.0+{-| Wrap the given text between double quotes++ __Examples__++ >>> quoteName "meow."+ "\"meow.\""++ @since 0.0.1.0+-} quoteName :: Text -> Text quoteName n = "\"" <> n <> "\"" --- | Wrap the given text between single quotes, for literal text in an SQL query.------ __Examples__------ >>> literal "meow."--- "'meow.'"------ @since 0.0.2.0+{-| Wrap the given text between single quotes, for literal text in an SQL query.++ __Examples__++ >>> literal "meow."+ "'meow.'"++ @since 0.0.2.0+-} literal :: Text -> Text literal n = "\'" <> escapeSingleQuotes n <> "\'" where escapeSingleQuotes x = T.replace "'" "''" x --- | Safe getter that quotes a table name------ __Examples__------ >>> getTableName @Author--- "\"authors\""--- >>> getTableName @Tags--- "public.\"tags\""------ @since 0.0.1.0+{-| Safe getter that quotes a table name++ __Examples__++ >>> getTableName @Author+ "\"authors\""+ >>> getTableName @Tags+ "public.\"tags\""++ @since 0.0.1.0+-} getTableName :: forall e. Entity e => Text getTableName = prefix (schema @e) <> quoteName (tableName @e) --- | Safe getter that quotes a table's primary key------ __Examples__------ >>> getPrimaryKey @Author--- "\"author_id\""--- >>> getPrimaryKey @Tags--- "\"category\""------ @since 0.0.2.0+{-| Safe getter that quotes a table's primary key++ __Examples__++ >>> getPrimaryKey @Author+ "\"author_id\""+ >>> getPrimaryKey @Tags+ "\"category\""++ @since 0.0.2.0+-} getPrimaryKey :: forall e. Entity e => Text getPrimaryKey = getFieldName $ primaryKey @e prefix :: Maybe Text -> Text prefix = maybe "" (<> ".") --- | Accessor to the name of a field, with quotation.------ >>> getFieldName ([field| author_id |])--- "\"author_id\""------ @since 0.0.2.0+{-| Accessor to the name of a field, with quotation.++ >>> getFieldName ([field| author_id |])+ "\"author_id\""++ @since 0.0.2.0+-} getFieldName :: Field -> Text getFieldName = quoteName . fieldName --- | Produce a comma-separated list of an entity's fields.------ __Examples__------ >>> expandFields @BlogPost--- "\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\""------ @since 0.0.1.0+{-| Produce a comma-separated list of an entity's fields.++ __Examples__++ >>> expandFields @BlogPost+ "\"blogpost_id\", \"author_id\", \"uuid_list\", \"title\", \"content\", \"created_at\""++ @since 0.0.1.0+-} expandFields :: forall e. Entity e => Text expandFields = V.foldl1' (\element acc -> element <> ", " <> acc) (getFieldName <$> fields @e) --- | Produce a comma-separated list of an entity's fields, qualified with the table name------ __Examples__------ >>> expandQualifiedFields @BlogPost--- "blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\""------ @since 0.0.1.0+{-| Produce a comma-separated list of an entity's fields, qualified with the table name++ __Examples__++ >>> expandQualifiedFields @BlogPost+ "blogposts.\"blogpost_id\", blogposts.\"author_id\", blogposts.\"uuid_list\", blogposts.\"title\", blogposts.\"content\", blogposts.\"created_at\""++ @since 0.0.1.0+-} expandQualifiedFields :: forall e. Entity e => Text expandQualifiedFields = expandQualifiedFields' (fields @e) prefixName where prefixName = tableName @e --- | Produce a comma-separated list of an entity's 'fields', qualified with an arbitrary prefix------ __Examples__------ >>> expandQualifiedFields' (fields @BlogPost) "legacy"--- "legacy.\"blogpost_id\", legacy.\"author_id\", legacy.\"uuid_list\", legacy.\"title\", legacy.\"content\", legacy.\"created_at\""------ @since 0.0.1.0+{-| Produce a comma-separated list of an entity's 'fields', qualified with an arbitrary prefix++ __Examples__++ >>> expandQualifiedFields' (fields @BlogPost) "legacy"+ "legacy.\"blogpost_id\", legacy.\"author_id\", legacy.\"uuid_list\", legacy.\"title\", legacy.\"content\", legacy.\"created_at\""++ @since 0.0.1.0+-} expandQualifiedFields' :: Vector Field -> Text -> Text expandQualifiedFields' fs prefixName = V.foldl1' (\element acc -> element <> ", " <> acc) fs' where@@ -173,102 +184,109 @@ -- --- | Take a prefix and a vector of fields, and qualifies each field with the prefix------ __Examples__------ >>> qualifyField @Author [field| name |]--- "authors.\"name\""------ @since 0.0.2.0+{-| Take a prefix and a vector of fields, and qualifies each field with the prefix++ __Examples__++ >>> qualifyField @Author [field| name |]+ "authors.\"name\""++ @since 0.0.2.0+-} qualifyField :: forall e. Entity e => Field -> Text qualifyField f = (\(Field fName _) -> p <> "." <> quoteName fName) f where p = tableName @e --- | Take a prefix and a vector of fields, and qualifies each field with the prefix------ __Examples__------ >>> qualifyFields "legacy" (fields @BlogPost)--- [Field "legacy.\"blogpost_id\"" Nothing,Field "legacy.\"author_id\"" Nothing,Field "legacy.\"uuid_list\"" Nothing,Field "legacy.\"title\"" Nothing,Field "legacy.\"content\"" Nothing,Field "legacy.\"created_at\"" Nothing]------ @since 0.0.1.0+{-| Take a prefix and a vector of fields, and qualifies each field with the prefix++ __Examples__++ >>> qualifyFields "legacy" (fields @BlogPost)+ [Field "legacy.\"blogpost_id\"" Nothing,Field "legacy.\"author_id\"" Nothing,Field "legacy.\"uuid_list\"" Nothing,Field "legacy.\"title\"" Nothing,Field "legacy.\"content\"" Nothing,Field "legacy.\"created_at\"" Nothing]++ @since 0.0.1.0+-} qualifyFields :: Text -> Vector Field -> Vector Field qualifyFields p fs = fmap (\(Field f t) -> Field (p <> "." <> quoteName f) t) fs --- | Produce a placeholder of the form @\"field\" = ?@ with an optional type annotation.------ __Examples__------ >>> placeholder [field| id |]--- "\"id\" = ?"------ >>> placeholder $ [field| ids |]--- "\"ids\" = ?"------ >>> fmap placeholder $ fields @BlogPost--- ["\"blogpost_id\" = ?","\"author_id\" = ?","\"uuid_list\" = ?","\"title\" = ?","\"content\" = ?","\"created_at\" = ?"]------ @since 0.0.1.0+{-| Produce a placeholder of the form @\"field\" = ?@ with an optional type annotation.++ __Examples__++ >>> placeholder [field| id |]+ "\"id\" = ?"++ >>> placeholder $ [field| ids |]+ "\"ids\" = ?"++ >>> fmap placeholder $ fields @BlogPost+ ["\"blogpost_id\" = ?","\"author_id\" = ?","\"uuid_list\" = ?","\"title\" = ?","\"content\" = ?","\"created_at\" = ?"]++ @since 0.0.1.0+-} placeholder :: Field -> Text placeholder (Field f Nothing) = quoteName f <> " = ?" placeholder (Field f (Just t)) = quoteName f <> " = ?::" <> t --- | Produce a placeholder of the form @table.\"field\" = ?@ with an optional type annotation.------ __Examples__------ >>> placeholder' @BlogPost [field| id |]--- "blogposts.\"id\" = ?"------ >>> placeholder' @BlogPost $ [field| ids |]--- "blogposts.\"ids\" = ?"------ @since 0.0.2.0+{-| Produce a placeholder of the form @table.\"field\" = ?@ with an optional type annotation.++ __Examples__++ >>> placeholder' @BlogPost [field| id |]+ "blogposts.\"id\" = ?"++ >>> placeholder' @BlogPost $ [field| ids |]+ "blogposts.\"ids\" = ?"++ @since 0.0.2.0+-} placeholder' :: forall e. Entity e => Field -> Text placeholder' f@(Field _ (Just t)) = qualifyField @e f <> " = ?::" <> t placeholder' f = qualifyField @e f <> " = ?" --- | Generate an appropriate number of “?” placeholders given a vector of fields.------ Used to generate INSERT queries.------ __Examples__------ >>> generatePlaceholders $ fields @BlogPost--- "?, ?, ?, ?, ?, ?"------ @since 0.0.1.0+{-| Generate an appropriate number of “?” placeholders given a vector of fields.++ Used to generate INSERT queries.++ __Examples__++ >>> generatePlaceholders $ fields @BlogPost+ "?, ?, ?, ?, ?, ?"++ @since 0.0.1.0+-} generatePlaceholders :: Vector Field -> Text generatePlaceholders vf = fold $ intercalateVector ", " $ fmap ph vf where ph (Field _ t) = maybe "?" (\t' -> "?::" <> t') t --- | Produce an IS NOT NULL statement given a vector of fields------ >>> isNotNull [ [field| possibly_empty |] ]--- "\"possibly_empty\" IS NOT NULL"------ >>> isNotNull [[field| possibly_empty |], [field| that_one_too |]]--- "\"possibly_empty\" IS NOT NULL AND \"that_one_too\" IS NOT NULL"------ @since 0.0.1.0+{-| Produce an IS NOT NULL statement given a vector of fields++ >>> isNotNull [ [field| possibly_empty |] ]+ "\"possibly_empty\" IS NOT NULL"++ >>> isNotNull [[field| possibly_empty |], [field| that_one_too |]]+ "\"possibly_empty\" IS NOT NULL AND \"that_one_too\" IS NOT NULL"++ @since 0.0.1.0+-} isNotNull :: Vector Field -> Text isNotNull fs' = fold $ intercalateVector " AND " (fmap process fieldNames) where fieldNames = fmap fieldName fs' process f = quoteName f <> " IS NOT NULL" --- | Produce an IS NULL statement given a vector of fields------ >>> isNull [ [field| possibly_empty |] ]--- "\"possibly_empty\" IS NULL"------ >>> isNull [[field| possibly_empty |], [field| that_one_too |]]--- "\"possibly_empty\" IS NULL AND \"that_one_too\" IS NULL"------ @since 0.0.1.0+{-| Produce an IS NULL statement given a vector of fields++ >>> isNull [ [field| possibly_empty |] ]+ "\"possibly_empty\" IS NULL"++ >>> isNull [[field| possibly_empty |], [field| that_one_too |]]+ "\"possibly_empty\" IS NULL AND \"that_one_too\" IS NULL"++ @since 0.0.1.0+-} isNull :: Vector Field -> Text isNull fs' = fold $ intercalateVector " AND " (fmap process fieldNames) where@@ -281,36 +299,39 @@ vals = fmap literal values process f' = quoteName $ fieldName f' --- | Since the 'Query' type has an 'IsString' instance, the process of converting from 'Text' to 'String' to 'Query' is--- factored into this function------ ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks--- @since 0.0.1.0+{-| Since the 'Query' type has an 'IsString' instance, the process of converting from 'Text' to 'String' to 'Query' is+ factored into this function++ ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks+ @since 0.0.1.0+-} textToQuery :: Text -> Query textToQuery = fromString . unpack --- | For cases where combinator composition is tricky, we can safely get back to a 'Text' string from a 'Query'------ ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks--- @since 0.0.1.0+{-| For cases where combinator composition is tricky, we can safely get back to a 'Text' string from a 'Query'++ ⚠ This may be dangerous and an unregulated usage of this function may expose to you SQL injection attacks+ @since 0.0.1.0+-} queryToText :: Query -> Text queryToText = decodeUtf8 . fromQuery --- | The 'intercalateVector' function takes a Text and a Vector Text and concatenates the vector after interspersing--- the first argument between each element of the list.------ __Examples__------ >>> intercalateVector "~" []--- []------ >>> intercalateVector "~" ["nyan"]--- ["nyan"]------ >>> intercalateVector "~" ["nyan", "nyan", "nyan"]--- ["nyan","~","nyan","~","nyan"]------ @since 0.0.1.0+{-| The 'intercalateVector' function takes a Text and a Vector Text and concatenates the vector after interspersing+ the first argument between each element of the list.++ __Examples__++ >>> intercalateVector "~" []+ []++ >>> intercalateVector "~" ["nyan"]+ ["nyan"]++ >>> intercalateVector "~" ["nyan", "nyan", "nyan"]+ ["nyan","~","nyan","~","nyan"]++ @since 0.0.1.0+-} intercalateVector :: Text -> Vector Text -> Vector Text intercalateVector sep vt | V.null vt = vt@@ -322,13 +343,14 @@ | V.null ys = ys | otherwise = V.cons sep (V.cons (V.head ys) (go (V.tail ys))) --- |------ __Examples__------ >>> renderSortExpression ([field| title |], ASC)--- "\"title\" ASC"------ @since 0.0.2.0+{-|++ __Examples__++ >>> renderSortExpression ([field| title |], ASC)+ "\"title\" ASC"++ @since 0.0.2.0+-} renderSortExpression :: (Field, SortKeyword) -> Text renderSortExpression (f, sort) = (quoteName . fieldName) f <> " " <> display sort
src/Database/PostgreSQL/Entity/Internal/BlogPost.hs view
@@ -2,19 +2,20 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE StrictData #-} --- |--- Module : Database.PostgreSQL.Entity.Internal.BlogPost--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- Koz Ross, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : stable------ Adapted from Clément Delafargue's [Yet Another Unsafe DB Layer](https://tech.fretlink.com/yet-another-unsafe-db-layer/)--- article.------ The models described in this module are used throughout the library's tests and docspecs.+{-|+ Module : Database.PostgreSQL.Entity.Internal.BlogPost+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ Koz Ross, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : stable++ Adapted from Clément Delafargue's [Yet Another Unsafe DB Layer](https://tech.fretlink.com/yet-another-unsafe-db-layer/)+ article.++ The models described in this module are used throughout the library's tests and docspecs.+-} module Database.PostgreSQL.Entity.Internal.BlogPost where import Data.Text (Text)@@ -81,8 +82,9 @@ ++ [Plain (char8 ']')] ++ [Plain (byteString " :: uuid[]")] --- | The BlogPost data-type. Look at its 'Entity' instance declaration for how to handle--- a "uuid[]" PostgreSQL type.+{-| The BlogPost data-type. Look at its 'Entity' instance declaration for how to handle+ a "uuid[]" PostgreSQL type.+-} data BlogPost = BlogPost { blogPostId :: BlogPostId -- ^ Primary key@@ -112,8 +114,9 @@ , [field| created_at |] ] --- | A specialisation of the 'Database.PostgreSQL.Entity.insert' function.--- @insertBlogPost = insert \@BlogPost@+{-| A specialisation of the 'Database.PostgreSQL.Entity.insert' function.+ @insertBlogPost = insert \@BlogPost@+-} insertBlogPost :: BlogPost -> DBT IO () insertBlogPost = insert @BlogPost @@ -124,8 +127,9 @@ bulkInsertBlogPosts :: [BlogPost] -> DBT IO () bulkInsertBlogPosts = insertMany @BlogPost --- | A specialisation of the 'Database.PostgreSQL.Entity.insert function.--- @insertAuthor = insert \@Author@+{-| A specialisation of the 'Database.PostgreSQL.Entity.insert function.+ @insertAuthor = insert \@Author@+-} insertAuthor :: Author -> DBT IO () insertAuthor = insert @Author
src/Database/PostgreSQL/Entity/Internal/QQ.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE TemplateHaskell #-} --- |--- Module : Database.PostgreSQL.Entity.Internal.QQ--- Copyright : © Koz Ross, 2021--- License : MIT--- Maintainer : koz.ross@retro-freedom.nz--- Stability : Experimental------ A quasi-quoter for 'Field's, supporting optional types.------ There is little reason to import this module directly; instead, import--- 'Database.PostgreSQL.Entity', which re-exports the 'field' quasiquoter.+{-|+ Module : Database.PostgreSQL.Entity.Internal.QQ+ Copyright : © Koz Ross, 2021+ License : MIT+ Maintainer : koz.ross@retro-freedom.nz+ Stability : Experimental++ A quasi-quoter for 'Field's, supporting optional types.++ There is little reason to import this module directly; instead, import+ 'Database.PostgreSQL.Entity', which re-exports the 'field' quasiquoter.+-} module Database.PostgreSQL.Entity.Internal.QQ (field) where import Data.Text (Text, pack)@@ -20,22 +21,23 @@ import Language.Haskell.TH.Syntax (lift) import Text.Parsec (Parsec, anyChar, manyTill, parse, space, spaces, string, try, (<|>)) --- | A quasi-quoter for safely constructing 'Field's.------ == Example:------ > instance Entity BlogPost where--- > tableName = "blogposts"--- > primaryKey = [field| blogpost_id |]--- > fields = [ [field| blogpost_id |]--- > , [field| author_id |]--- > , [field| uuid_list :: uuid[] |] -- ← This is where we specify an optional PostgreSQL type annotation--- > , [field| title |]--- > , [field| content |]--- > , [field| created_at |]--- > ]------ @since 0.1.0.0+{-| A quasi-quoter for safely constructing 'Field's.++ == Example:++ > instance Entity BlogPost where+ > tableName = "blogposts"+ > primaryKey = [field| blogpost_id |]+ > fields = [ [field| blogpost_id |]+ > , [field| author_id |]+ > , [field| uuid_list :: uuid[] |] -- ← This is where we specify an optional PostgreSQL type annotation+ > , [field| title |]+ > , [field| content |]+ > , [field| created_at |]+ > ]++ @since 0.1.0.0+-} field :: QuasiQuoter field = QuasiQuoter fieldExp errorFieldPat errorFieldType errorFieldDec
src/Database/PostgreSQL/Entity/Internal/Unsafe.hs view
@@ -2,25 +2,26 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} --- |--- Module : Database.PostgreSQL.Entity.Internal.Unsafe--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- Koz Ross, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : Experimental------ Contains the internals of several key types.------ = Note------ By using these directly, you run the risk of violating internal invariants,--- or making representational changes in incompatible ways. This API is not--- stable, and is not subject to the PVP. Use at your own risk------ If at all possible, instead use the API provided by--- 'Database.PostgreSQL.Entity.Types'.+{-|+ Module : Database.PostgreSQL.Entity.Internal.Unsafe+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ Koz Ross, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : Experimental++ Contains the internals of several key types.++ = Note++ By using these directly, you run the risk of violating internal invariants,+ or making representational changes in incompatible ways. This API is not+ stable, and is not subject to the PVP. Use at your own risk++ If at all possible, instead use the API provided by+ 'Database.PostgreSQL.Entity.Types'.+-} module Database.PostgreSQL.Entity.Internal.Unsafe ( Field (..) )@@ -31,9 +32,10 @@ import Data.Text (Text) import GHC.TypeLits --- | A wrapper for table fields.------ @since 0.0.1.0+{-| A wrapper for table fields.++ @since 0.0.1.0+-} data Field = Field Text (Maybe Text) deriving stock (Eq, Show)
src/Database/PostgreSQL/Entity/Types.hs view
@@ -3,15 +3,16 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} --- |--- Module : Database.PostgreSQL.Entity.Types--- Copyright : © Clément Delafargue, 2018--- Théophile Choutri, 2021--- License : MIT--- Maintainer : theophile@choutri.eu--- Stability : stable------ Types and classes+{-|+ Module : Database.PostgreSQL.Entity.Types+ Copyright : © Clément Delafargue, 2018+ Théophile Choutri, 2021+ License : MIT+ Maintainer : theophile@choutri.eu+ Stability : stable++ Types and classes+-} module Database.PostgreSQL.Entity.Types ( -- * The /Entity/ Typeclass Entity (..)@@ -60,28 +61,29 @@ import GHC.Generics import GHC.TypeLits --- | An 'Entity' stores the following information about the structure of a database table:------ * Its name--- * Its primary key--- * The fields it contains------ == Example------ > data ExampleEntity = E--- > { key :: Key--- > , field1 :: Int--- > , field2 :: Bool--- > }--- > deriving stock (Eq, Show, Generic)--- > deriving anyclass (FromRow, ToRow)--- > deriving Entity--- > via (GenericEntity '[TableName "entities"] ExampleEntity)------ When using the functions provided by this library, you will sometimes need to be explicit about the Entity you are--- referring to.------ @since 0.0.1.0+{-| An 'Entity' stores the following information about the structure of a database table:++ * Its name+ * Its primary key+ * The fields it contains++ == Example++ > data ExampleEntity = E+ > { key :: Key+ > , field1 :: Int+ > , field2 :: Bool+ > }+ > deriving stock (Eq, Show, Generic)+ > deriving anyclass (FromRow, ToRow)+ > deriving Entity+ > via (GenericEntity '[TableName "entities"] ExampleEntity)++ When using the functions provided by this library, you will sometimes need to be explicit about the Entity you are+ referring to.++ @since 0.0.1.0+-} class Entity e where -- | The name of the table in the PostgreSQL database. tableName :: Text@@ -135,8 +137,8 @@ getTableName opts = getTableName @e opts instance- (KnownSymbol name) =>- GetTableName (M1 D ( 'MetaData name _1 _2 _3) e)+ (KnownSymbol name)+ => GetTableName (M1 D ( 'MetaData name _1 _2 _3) e) where getTableName Options{tableNameModifiers, fieldModifiers} = tableNameModifiers $ fieldModifiers $ T.pack $ symbolVal (Proxy :: Proxy name) @@ -247,12 +249,13 @@ -- | CamelCase to kebab-case type CamelToKebab = CamelTo "-" --- | The modifiers that you can apply to the fields:------ * 'StripPrefix'--- * 'CamelTo', and its variations--- * 'CamelToSnake'--- * 'CamelToKebab'+{-| The modifiers that you can apply to the fields:++ * 'StripPrefix'+ * 'CamelTo', and its variations+ * 'CamelToSnake'+ * 'CamelToKebab'+-} class TextModifier t where getTextModifier :: Text -> Text @@ -294,22 +297,25 @@ NonEmptyText "" = TypeError ( 'Text "User-provided string cannot be empty!") NonEmptyText _ = () --- | Get the name of a field.------ @since 0.1.0.0+{-| Get the name of a field.++ @since 0.1.0.0+-} fieldName :: Field -> Text fieldName (Field name _) = name --- | Get the type of a field, if any.------ @since 0.1.0.0+{-| Get the type of a field, if any.++ @since 0.1.0.0+-} fieldType :: Field -> Maybe Text fieldType (Field _ typ) = typ --- | Wrapper used by the update function in order to have the primary key as the last parameter passed,--- since it appears in the WHERE clause.------ @since 0.0.1.0+{-| Wrapper used by the update function in order to have the primary key as the last parameter passed,+ since it appears in the WHERE clause.++ @since 0.0.1.0+-} newtype UpdateRow a = UpdateRow {getUpdate :: a} deriving stock (Eq, Show) deriving newtype (Entity)@@ -317,8 +323,9 @@ instance ToRow a => ToRow (UpdateRow a) where toRow = (drop <> take) 1 . toRow . getUpdate --- |--- @since 0.0.2.0+{-|+ @since 0.0.2.0+-} data SortKeyword = ASC | DESC deriving stock (Eq, Show) deriving