diff --git a/persistent-sql-lifted/CHANGELOG.md b/persistent-sql-lifted/CHANGELOG.md index 2f51b81..42a2ee9 100644 --- a/persistent-sql-lifted/CHANGELOG.md +++ b/persistent-sql-lifted/CHANGELOG.md @@ -1,4 +1,20 @@ -## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.3.0.0...main) +## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.0.0...main) + +## [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) + +Remove `selectKeys` because Persistent's Conduit-based utilities are of dubious correctness. + +Add: + +- `deleteWhereCount` +- `existsBy` +- `getFieldName` +- `getTableName` +- `insertUnique_` +- `rawExecute` +- `rawExecuteCount` +- `rawSql` +- `updateWhereCount` ## [v0.3.0.0](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.2.0.0...persistent-sql-lifted-v0.3.0.0) diff --git a/persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs b/persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs index a0df1d8..71186de 100644 --- a/persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs +++ b/persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs @@ -34,13 +34,13 @@ module Database.Persist.Sql.Lifted , select , selectOne , selectFirst - , selectKeys , selectKeysList , selectList -- * Selecting counts/existence , count , exists + , existsBy -- * Inserting , insertSelect @@ -55,6 +55,7 @@ module Database.Persist.Sql.Lifted , insertMany_ , insertRecord , insertUnique + , insertUnique_ , insertUniqueEntity -- * Updating @@ -63,6 +64,7 @@ module Database.Persist.Sql.Lifted , update' , updateGet , updateWhere + , updateWhereCount -- * Insert/update combinations , replace @@ -84,6 +86,7 @@ module Database.Persist.Sql.Lifted , deleteBy , deleteWhere , deleteCount + , deleteWhereCount -- * Transactions , transactionSave @@ -91,6 +94,15 @@ module Database.Persist.Sql.Lifted , transactionUndo , transactionUndoWithIsolation + -- * Raw SQL + , rawSql + , rawExecute + , rawExecuteCount + + -- * Getting names + , getFieldName + , getTableName + -- * Rendering queries to text , renderQueryDelete , renderQueryInsertInto diff --git a/persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Persistent.hs b/persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Persistent.hs index f0f65d8..1a7facb 100644 --- a/persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Persistent.hs +++ b/persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Persistent.hs @@ -8,14 +8,18 @@ module Database.Persist.Sql.Lifted.Persistent , delete , deleteBy , deleteWhere + , deleteWhereCount , exists + , existsBy , get , getBy , getByValue , getEntity + , getFieldName , getJust , getJustEntity , getMany + , getTableName , insert , insert_ , insertBy @@ -26,15 +30,18 @@ module Database.Persist.Sql.Lifted.Persistent , insertMany_ , insertRecord , insertUnique + , insertUnique_ , insertUniqueEntity , onlyUnique , putMany + , rawExecute + , rawExecuteCount + , rawSql , replace , replaceUnique , repsert , repsertMany , selectFirst - , selectKeys , selectKeysList , selectList , transactionSave @@ -44,33 +51,35 @@ module Database.Persist.Sql.Lifted.Persistent , update , updateGet , updateWhere + , updateWhereCount , upsert , upsertBy ) where -import Conduit (ConduitT, MonadResource, transPipe) import Data.Bool (Bool) import Data.Either (Either) import Data.Eq (Eq) import Data.Function (($)) -import Data.Int (Int) +import Data.Int (Int, Int64) import Data.Map.Strict (Map) import Data.Maybe (Maybe) #if MIN_VERSION_base(4,17,0) import Data.Type.Equality (type (~)) #endif +import Data.Text (Text) import Database.Persist ( AtLeastOneUniqueKey , Entity , Filter , OnlyOneUniqueKey , PersistEntity (..) + , PersistValue , SelectOpt , Update ) import Database.Persist.Class qualified as P import Database.Persist.Class.PersistEntity (SafeToInsert) -import Database.Persist.Sql (IsolationLevel) +import Database.Persist.Sql (IsolationLevel, RawSql) import Database.Persist.Sql qualified as P import Database.Persist.Sql.Lifted.Core (MonadSqlBackend, SqlBackend, liftSql) import GHC.Stack (HasCallStack) @@ -160,6 +169,20 @@ deleteWhere -> m () deleteWhere fs = liftSql $ P.deleteWhere fs +-- | Delete all records matching the given criteria +deleteWhereCount + :: forall a m + . ( PersistEntity a + , PersistEntityBackend a ~ SqlBackend + , MonadSqlBackend m + , HasCallStack + ) + => [Filter a] + -- ^ If you provide multiple values in the list, the conditions are ANDed together. + -> m Int64 + -- ^ The number of rows affected +deleteWhereCount fs = liftSql $ P.deleteWhereCount fs + -- | Check if there is at least one record fulfilling the given criteria exists :: forall a m @@ -173,6 +196,18 @@ exists -> m Bool exists fs = liftSql $ P.exists fs +-- | Check if a record with this unique key exists +existsBy + :: forall a m + . ( PersistEntity a + , PersistEntityBackend a ~ SqlBackend + , MonadSqlBackend m + , HasCallStack + ) + => Unique a + -> m Bool +existsBy u = liftSql $ P.existsBy u + -- | Get a record by identifier, if available get :: forall a m @@ -224,6 +259,18 @@ getEntity -> m (Maybe (Entity a)) getEntity k = liftSql $ P.getEntity k +-- | Get the SQL string for the field that an 'EntityField' represents +getFieldName + :: forall a t m + . ( PersistEntity a + , PersistEntityBackend a ~ SqlBackend + , MonadSqlBackend m + , HasCallStack + ) + => EntityField a t + -> m Text +getFieldName f = liftSql $ P.getFieldName f + -- | Get a record by identifier, if available, for a non-null (not 'Maybe') foreign key -- -- Unsafe unless your database is enforcing that the foreign key is valid. @@ -264,6 +311,11 @@ getMany -> m (Map (Key a) a) getMany ks = liftSql $ P.getMany ks +-- | Get the SQL string for the table that a 'PersistEntity' represents +getTableName + :: forall a m. (PersistEntity a, MonadSqlBackend m, HasCallStack) => a -> m Text +getTableName x = liftSql $ P.getTableName x + -- | Create a new record in the database insert :: forall a m @@ -399,6 +451,21 @@ insertUnique -- inserted because of a uniqueness constraint insertUnique a = liftSql $ P.insertUnique a +-- | Create a new record in the database +insertUnique_ + :: forall a m + . ( PersistEntity a + , PersistEntityBackend a ~ SqlBackend + , SafeToInsert a + , MonadSqlBackend m + , HasCallStack + ) + => a + -> m (Maybe ()) + -- ^ (), or 'Nothing' when the record couldn't be inserted because of a + -- uniqueness constraint +insertUnique_ a = liftSql $ P.insertUnique_ a + -- | Create a new record in the database insertUniqueEntity :: forall a m @@ -443,6 +510,39 @@ putMany -> m () putMany as = liftSql $ P.putMany as +-- | Execute a raw SQL statement +rawExecute + :: forall m + . (MonadSqlBackend m, HasCallStack) + => Text + -- ^ SQL statement, possibly with placeholders + -> [PersistValue] + -- ^ Values to fill the placeholders + -> m () +rawExecute t vs = liftSql $ P.rawExecute t vs + +-- | Execute a raw SQL statement +rawExecuteCount + :: forall m + . (MonadSqlBackend m, HasCallStack) + => Text + -- ^ SQL statement, possibly with placeholders + -> [PersistValue] + -- ^ Values to fill the placeholders + -> m Int64 + -- ^ The number of rows modified +rawExecuteCount t vs = liftSql $ P.rawExecuteCount t vs + +rawSql + :: forall a m + . (RawSql a, MonadSqlBackend m, HasCallStack) + => Text + -- ^ SQL statement, possibly with placeholders + -> [PersistValue] + -- ^ Values to fill the placeholders + -> m [a] +rawSql sql vals = liftSql $ P.rawSql sql vals + -- | Replace the record in the database with the given key -- -- The result is undefined if such record does not exist. @@ -519,22 +619,6 @@ selectFirst -> m (Maybe (Entity a)) selectFirst fs os = liftSql $ P.selectFirst fs os --- | Get the 'Key's of all records matching the given criteria -selectKeys - :: forall a m - . ( PersistEntity a - , PersistEntityBackend a ~ SqlBackend - , MonadSqlBackend m - , MonadResource m - , HasCallStack - ) - => [Filter a] - -- ^ If you provide multiple values in the list, the conditions are ANDed together. - -> [SelectOpt a] - -> ConduitT () (Key a) m () - -- ^ Keys corresponding to the filters and options provided -selectKeys fs os = transPipe liftSql $ P.selectKeys fs os - -- | Get the 'Key's of all records matching the given criteria selectKeysList :: forall a m @@ -631,6 +715,21 @@ updateWhere -> m () updateWhere fs us = liftSql $ P.updateWhere fs us +-- | Update individual fields on any record matching the given criteria +updateWhereCount + :: forall a m + . ( PersistEntity a + , PersistEntityBackend a ~ SqlBackend + , MonadSqlBackend m + , HasCallStack + ) + => [Filter a] + -- ^ If you provide multiple values in the list, the conditions are ANDed together. + -> [Update a] + -> m Int64 + -- ^ The number of rows affected +updateWhereCount fs us = liftSql $ P.updateWhereCount fs us + -- | Update based on a uniqueness constraint or insert: -- -- * Unsert the new record if it does not exist; diff --git a/persistent-sql-lifted/package.yaml b/persistent-sql-lifted/package.yaml index bf27578..c1a6de6 100644 --- a/persistent-sql-lifted/package.yaml +++ b/persistent-sql-lifted/package.yaml @@ -1,5 +1,5 @@ name: persistent-sql-lifted -version: 0.3.0.0 +version: 0.4.0.0 maintainer: Freckle Education category: Database @@ -59,7 +59,6 @@ library: source-dirs: library dependencies: - annotated-exception - - conduit - containers - esqueleto - mtl diff --git a/persistent-sql-lifted/persistent-sql-lifted.cabal b/persistent-sql-lifted/persistent-sql-lifted.cabal index 3471449..fa248d5 100644 --- a/persistent-sql-lifted/persistent-sql-lifted.cabal +++ b/persistent-sql-lifted/persistent-sql-lifted.cabal @@ -5,7 +5,7 @@ cabal-version: 1.18 -- see: https://github.com/sol/hpack name: persistent-sql-lifted -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Monad classes for running queries with Persistent and Esqueleto description: This package introduces two classes: MonadSqlBackend for monadic contexts in which a SqlBackend is available, and MonadSqlTx for contexts in which we @@ -84,7 +84,6 @@ library build-depends: annotated-exception , base <5 - , conduit , containers , esqueleto , mtl