Skip to content

Commit

Permalink
add more Persistent functions, remove one
Browse files Browse the repository at this point in the history
  • Loading branch information
chris-martin committed Jan 17, 2025
1 parent 0f58fbd commit 68742e0
Show file tree
Hide file tree
Showing 5 changed files with 151 additions and 26 deletions.
18 changes: 17 additions & 1 deletion persistent-sql-lifted/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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)

Expand Down
14 changes: 13 additions & 1 deletion persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,13 +34,13 @@ module Database.Persist.Sql.Lifted
, select
, selectOne
, selectFirst
, selectKeys
, selectKeysList
, selectList

-- * Selecting counts/existence
, count
, exists
, existsBy

-- * Inserting
, insertSelect
Expand All @@ -55,6 +55,7 @@ module Database.Persist.Sql.Lifted
, insertMany_
, insertRecord
, insertUnique
, insertUnique_
, insertUniqueEntity

-- * Updating
Expand All @@ -63,6 +64,7 @@ module Database.Persist.Sql.Lifted
, update'
, updateGet
, updateWhere
, updateWhereCount

-- * Insert/update combinations
, replace
Expand All @@ -84,13 +86,23 @@ module Database.Persist.Sql.Lifted
, deleteBy
, deleteWhere
, deleteCount
, deleteWhereCount

-- * Transactions
, transactionSave
, transactionSaveWithIsolation
, transactionUndo
, transactionUndoWithIsolation

-- * Raw SQL
, rawSql
, rawExecute
, rawExecuteCount

-- * Getting names
, getFieldName
, getTableName

-- * Rendering queries to text
, renderQueryDelete
, renderQueryInsertInto
Expand Down
139 changes: 119 additions & 20 deletions persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Persistent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
3 changes: 1 addition & 2 deletions persistent-sql-lifted/package.yaml
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: persistent-sql-lifted
version: 0.3.0.0
version: 0.4.0.0

maintainer: Freckle Education
category: Database
Expand Down Expand Up @@ -59,7 +59,6 @@ library:
source-dirs: library
dependencies:
- annotated-exception
- conduit
- containers
- esqueleto
- mtl
Expand Down
3 changes: 1 addition & 2 deletions persistent-sql-lifted/persistent-sql-lifted.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -84,7 +84,6 @@ library
build-depends:
annotated-exception
, base <5
, conduit
, containers
, esqueleto
, mtl
Expand Down

0 comments on commit 68742e0

Please sign in to comment.