persistent-sql-lifted: add query runners

freckle-app/library/Freckle/App/Database.hs

@@ -48,15 +48,13 @@ import Data.HashMap.Strict qualified as HashMap
 import Data.Pool
 import Data.Text qualified as T
 import Database.Persist.Postgresql
-  ( SqlBackend
-  , SqlPersistT
+  ( SqlPersistT
   , createPostgresqlPoolModified
   , createSqlPool
   , openSimpleConn
   , runSqlPool
   , runSqlPoolWithExtensibleHooks
   )
-import Database.Persist.Sql.Lifted
 import Database.Persist.SqlBackend.Internal.SqlPoolHooks (SqlPoolHooks (..))
 import Database.Persist.SqlBackend.SqlPoolHooks
 import Database.PostgreSQL.Simple

persistent-sql-lifted/CHANGELOG.md

@@ -1,4 +1,8 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/persistent-sql-lifted-v0.0.0.0...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/persistent-sql-lifted-v0.1.0.0...main)
+
+## [v0.0.0.1](https://github.com/freckle/freckle-app/compare/persistent-sql-lifted-v0.0.0.0...persistent-sql-lifted-v0.1.0.0)
+
+Major expansion, adding query runners for Persistent and Esqueleto.
 
 ## [v0.0.0.0](https://github.com/freckle/freckle-app/tree/persistent-sql-lifted-v0.0.0.0/persistent-sql-lifted)
 

persistent-sql-lifted/README.md

@@ -1,13 +1,30 @@
 # persistent-sql-lifted
 
-How to migrate from vanilla [persistent]:
+This package introduces two classes:
+
+- `MonadSqlBackend m`, for monadic contexts `m` in which a `SqlBackend` is available
+
+- `MonadSqlBackend db m`, for monadic contexts `m` in which we can execute a SQL
+  transaction of type `db a` and get a result `m a`. (The type `db` should have an
+  instance of `MonadSqlBackend.)
+
+Additionally, this package provides variants of query-running utilities from
+[persistent] and [esqueleto] which are
+
+1. Concretized to use `SqlBackend`;
+2. Generalized to a `MonadSqlBackend m` constraint rather than `ReaderT backend m`;
+3. Wrapped in [checkpointCallStack] so that exceptions will include call stacks.
+
+How to migrate from vanilla persistent/esqueleto:
 
 - Instead of [SqlPersistT], use a `MonadSqlBackend` constraint.
 - Define an instance of `MonadSqlTx` for your application Monad that specifies how
   your application runs database transactions, e.g. by running [runSqlPool].
 - 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
-  [SqlPersistT]: https://hackage.haskell.org/package/persistent-2.14.6.3/docs/Database-Persist-Sql.html#t:SqlPersistT
   [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

persistent-sql-lifted/library/Database/Persist/Sql/Lifted.hs

@@ -1,10 +1,115 @@
+-- |
+--
+-- Re-exports from:
+--
+-- * "Database.Persist.Sql.Lifted.Core"
+-- * "Database.Persist.Sql.Lifted.Persistent"
+-- * "Database.Persist.Sql.Lifted.Esqueleto"
+--
+-- There are a few name conflicts between Persistent and Esqueleto. Where conflicts occur, this
+-- module gives preference to Esqueleto. The following Persistent definitions are renamed:
+--
+-- * 'Database.Persist.Sql.Lifted.Persistent.delete' -> 'deleteKey'
+-- * 'Database.Persist.Sql.Lifted.Persistent.update' -> 'update''
 module Database.Persist.Sql.Lifted
-  ( MonadSqlTx (..)
+  ( -- * Core concepts
+    MonadSqlTx (..)
   , HasSqlBackend (..)
+  , SqlBackend
   , MonadSqlBackend (..)
   , liftSql
+
+    -- * Getting by key
+  , get
+  , getBy
+  , getByValue
+  , getEntity
+  , getJust
+  , getJustEntity
+  , getMany
+
+    -- * Selecting by filter
+  , select
+  , selectOne
+  , selectFirst
+  , selectKeys
+  , selectKeysList
+  , selectList
+
+    -- * Selecting counts/existence
+  , count
+  , exists
+  , existsBy
+
+    -- * Inserting
+  , insertSelect
+  , insertSelectCount
+  , insert
+  , insert_
+  , insertBy
+  , insertEntity
+  , insertEntityMany
+  , insertKey
+  , insertMany
+  , insertMany_
+  , insertRecord
+  , insertUnique
+  , insertUnique_
+  , insertUniqueEntity
+
+    -- * Updating
+  , update
+  , updateCount
+  , update'
+  , updateGet
+  , updateWhere
+
+    -- * Insert/update combinations
+  , replace
+  , replaceUnique
+  , repsert
+  , repsertMany
+  , upsert
+  , upsertBy
+  , putMany
+
+    -- * Working with unique constraints
+  , checkUnique
+  , checkUniqueUpdateable
+  , onlyUnique
+
+    -- * Deleting
+  , delete
+  , deleteKey
+  , deleteBy
+  , deleteWhere
+  , deleteCount
+
+    -- * Rendering queries to text
+  , renderQueryDelete
+  , renderQueryInsertInto
+  , renderQuerySelect
+  , renderQueryToText
+  , renderQueryUpdate
   ) where
 
-import Database.Persist.Sql.Lifted.HasSqlBackend
-import Database.Persist.Sql.Lifted.MonadSqlBackend
-import Database.Persist.Sql.Lifted.MonadSqlTx
+import Data.Type.Equality (type (~))
+import Database.Persist (Key, PersistEntity (PersistEntityBackend), Update)
+import Database.Persist.Sql.Lifted.Core
+import Database.Persist.Sql.Lifted.Esqueleto
+import Database.Persist.Sql.Lifted.Persistent hiding (delete, update)
+import Database.Persist.Sql.Lifted.Persistent qualified as Persistent
+import GHC.Stack (HasCallStack)
+
+-- | Update individual fields on a specific record
+update'
+  :: forall a m
+   . ( PersistEntity a
+     , PersistEntityBackend a ~ SqlBackend
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => Key a
+  -> [Update a]
+  -> m ()
+update' = Persistent.update

persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Core.hs

@@ -0,0 +1,12 @@
+module Database.Persist.Sql.Lifted.Core
+  ( MonadSqlTx (..)
+  , HasSqlBackend (..)
+  , SqlBackend
+  , MonadSqlBackend (..)
+  , liftSql
+  ) where
+
+import Database.Persist.Sql (SqlBackend)
+import Database.Persist.Sql.Lifted.HasSqlBackend
+import Database.Persist.Sql.Lifted.MonadSqlBackend
+import Database.Persist.Sql.Lifted.MonadSqlTx

persistent-sql-lifted/library/Database/Persist/Sql/Lifted/Esqueleto.hs

@@ -0,0 +1,198 @@
+-- | Wrappers that apply 'liftSql' to Esqueleto utilities of the same name.
+module Database.Persist.Sql.Lifted.Esqueleto
+  ( delete
+  , deleteCount
+  , deleteKey
+  , insertSelect
+  , insertSelectCount
+  , renderQueryDelete
+  , renderQueryInsertInto
+  , renderQuerySelect
+  , renderQueryToText
+  , renderQueryUpdate
+  , select
+  , selectOne
+  , update
+  , updateCount
+  ) where
+
+import Data.Function (($))
+import Data.Int (Int64)
+import Data.Maybe (Maybe)
+import Data.Text (Text)
+import Data.Type.Equality (type (~))
+import Database.Esqueleto.Experimental
+  ( Entity
+  , PersistEntity (Key, PersistEntityBackend)
+  , PersistValue
+  , SqlExpr
+  , SqlQuery
+  )
+import Database.Esqueleto.Experimental qualified as E
+import Database.Esqueleto.Internal.Internal (Insertion, Mode, SqlSelect)
+import Database.Persist.Sql.Lifted.Core (MonadSqlBackend, SqlBackend, liftSql)
+import GHC.Stack (HasCallStack)
+
+-- | Execute an Esqueleto DELETE query
+delete :: forall m. (MonadSqlBackend m, HasCallStack) => SqlQuery () -> m ()
+delete q = liftSql $ E.delete q
+
+-- | Execute an Esqueleto DELETE query
+deleteCount
+  :: forall m
+   . (MonadSqlBackend m, HasCallStack)
+  => SqlQuery ()
+  -> m Int64
+  -- ^ The number of rows affected
+deleteCount q = liftSql $ E.deleteCount q
+
+-- | Delete a specific record by identifier
+--
+-- Does nothing if record does not exist.
+deleteKey
+  :: forall a m
+   . ( PersistEntity a
+     , PersistEntityBackend a ~ SqlBackend
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => Key a
+  -> m ()
+deleteKey k = liftSql $ E.deleteKey k
+
+-- | Insert a 'E.PersistField' for every selected value
+insertSelect
+  :: forall a m
+   . ( PersistEntity a
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery (SqlExpr (Insertion a))
+  -> m ()
+insertSelect q = liftSql $ E.insertSelect q
+
+-- | Insert a 'PersistField' for every selected value, returning the count
+insertSelectCount
+  :: forall a m
+   . ( PersistEntity a
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery (SqlExpr (Insertion a))
+  -> m Int64
+  -- ^ The number of inserted rows
+insertSelectCount q = liftSql $ E.insertSelectCount q
+
+-- | Renders a 'SqlQuery' to 'Text' along with the list of 'PersistValue's
+--   that would be supplied to the database for @?@ placeholders
+renderQueryDelete
+  :: forall a r m
+   . ( SqlSelect a r
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery a
+  -- ^ SQL query to render
+  -> m (Text, [PersistValue])
+renderQueryDelete q = liftSql $ E.renderQueryDelete q
+
+-- | Renders a 'SqlQuery' to 'Text' along with the list of 'PersistValue's
+--   that would be supplied to the database for @?@ placeholders
+renderQueryInsertInto
+  :: forall a r m
+   . ( SqlSelect a r
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery a
+  -- ^ SQL query to render
+  -> m (Text, [PersistValue])
+renderQueryInsertInto q = liftSql $ E.renderQueryInsertInto q
+
+-- | Renders a 'SqlQuery' to 'Text' along with the list of 'PersistValue's
+--   that would be supplied to the database for @?@ placeholders
+renderQuerySelect
+  :: forall a r m
+   . ( SqlSelect a r
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery a
+  -- ^ SQL query to render
+  -> m (Text, [PersistValue])
+renderQuerySelect q = liftSql $ E.renderQuerySelect q
+
+-- | Renders a 'SqlQuery' to 'Text' along with the list of 'PersistValue's
+--   that would be supplied to the database for @?@ placeholders
+renderQueryToText
+  :: forall a r m
+   . ( SqlSelect a r
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => Mode
+  -- ^ Whether to render as an SELECT, DELETE, etc.
+  --   You must ensure that the Mode you pass to this function corresponds
+  --   with the actual SqlQuery. If you pass a query that uses incompatible
+  --   features (like an INSERT statement with a SELECT mode) then you'll
+  --   get a weird result.
+  -> SqlQuery a
+  -- ^ SQL query to render
+  -> m (Text, [PersistValue])
+renderQueryToText m q = liftSql $ E.renderQueryToText m q
+
+-- | Renders a 'SqlQuery' to 'Text' along with the list of 'PersistValue's
+--   that would be supplied to the database for @?@ placeholders
+renderQueryUpdate
+  :: forall a r m
+   . ( SqlSelect a r
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => SqlQuery a
+  -- ^ SQL query to render
+  -> m (Text, [PersistValue])
+renderQueryUpdate q = liftSql $ E.renderQueryUpdate q
+
+-- | Execute an Esqueleto SELECT query
+select
+  :: forall a r m
+   . (SqlSelect a r, MonadSqlBackend m, HasCallStack)
+  => SqlQuery a
+  -> m [r]
+  -- ^ A list of rows
+select q = liftSql $ E.select q
+
+-- | Execute an Esqueleto SELECT query, getting only the first row
+selectOne
+  :: forall a r m
+   . (SqlSelect a r, MonadSqlBackend m, HasCallStack)
+  => SqlQuery a
+  -> m (Maybe r)
+  -- ^ The first row, or 'Nothing' if no rows are selected
+selectOne q = liftSql $ E.selectOne q
+
+-- | Execute an Esqueleto UPDATE query
+update
+  :: forall a m
+   . ( PersistEntity a
+     , PersistEntityBackend a ~ SqlBackend
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => (SqlExpr (Entity a) -> SqlQuery ())
+  -> m ()
+update q = liftSql $ E.update q
+
+-- | Execute an Esqueleto UPDATE query, returning the count
+updateCount
+  :: forall a m
+   . ( PersistEntity a
+     , PersistEntityBackend a ~ SqlBackend
+     , MonadSqlBackend m
+     , HasCallStack
+     )
+  => (SqlExpr (Entity a) -> SqlQuery ())
+  -> m Int64
+  -- ^ The number of inserted rows
+updateCount q = liftSql $ E.updateCount q