effectful-postgresql (empty) → 0.1.0.0
raw patch · 7 files changed
+618/−0 lines, 7 filesdep +basedep +effectful-coredep +effectful-th
Dependencies added: base, effectful-core, effectful-th, postgresql-simple, unliftio-pool
Files
- CHANGELOG.md +20/−0
- LICENSE +30/−0
- README.md +84/−0
- effectful-postgresql.cabal +81/−0
- src/Effectful/PostgreSQL.hs +318/−0
- src/Effectful/PostgreSQL/Connection.hs +57/−0
- src/Effectful/PostgreSQL/Connection/Pool.hs +28/−0
+ CHANGELOG.md view
@@ -0,0 +1,20 @@+# Changelog++All notable changes to `effectful-postgresql` will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org).++## [Unreleased]++## [0.1.0.0] - 22.07.2025++### Added++- First edition of the package, ready for feedback.+- 100% documentation coverage.+- Reasonably detailed READMEs+- CI that builds and tests the packages for each version of GHC in the `tested-with` field.++[unreleased]: https://github.com/fpringle/effectful-postgresql/compare/v0.1.0.0...HEAD+[0.1.0.0]: https://github.com/fpringle/effectful-postgresql/releases/tag/v0.1.0.0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2025, Frederick Pringle++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Frederick Pringle nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,84 @@+# effectful-postgresql++This package provides an `effectful` effect for [postgresql-simple](https://hackage.haskell.org/package/postgresql-simple)'s `Connection` type.++It defines a dynamic effect to allow effectful functions to use a `Connection`, without worrying about where that `Connection` comes from.++For a higher-level effect library using [Opaleye](https://hackage.haskell.org/package/opaleye), see [effectful-opaleye](https://github.com/fpringle/effectful-postgresql/blob/main/effectful-opaleye#readme).++## Effectful functions++In the `WithConnection` effect we can always request a `Connection` and use it as we normally+would:++```haskell+import Effectful.PostgreSQL as EP+import qualified Database.PostgreSQL.Simple as PSQL++insertAndList :: (EP.WithConnection :> es, IOE :> es) => Eff es [User]+insertAndList = EP.withConnection $ \conn -> do+ PSQL.execute conn "insert into users (first_name) values (?)" ["Nuala"]+ PSQL.query conn "select * from users where first_name in ?" $ Only $ In ["Anna", "Boris", "Carla"]+```++In fact, for convenience we also define lifted versions of all of the query/execute+functions from `postgresql-simple`, so we can completely forget about `Connection` and rewrite the above to:++```haskell++import Effectful.PostgreSQL++insertAndList :: (EP.WithConnection :> es, IOE :> es) => Eff es [User]+insertAndList = do+ EP.execute "insert into users (first_name) values (?)" ["Nuala"]+ EP.query "select * from users where first_name in ?" $ Only $ In ["Anna", "Boris", "Carla"]+```++The same goes for other functions:++```haskell+-- use a transaction+insertAndListCarefully :: (EP.WithConnection :> es, IOE :> es) => Eff es [User]+insertAndListCarefully = EP.withTransaction insertAndList++-- stream + fold over results (in Eff)+countUsersIneffeciently :: (EP.WithConnection :> es, IOE :> es, Log :> es) => Eff es Int+countUsersIneffeciently =+ EP.fold_ "select * from users" 0 $ \acc row ->+ log $ "User: " <> show row+ pure $ acc + 1+```++## Interpreters++The simplest way of running the `WithConnection` effect is by just providing a `Connection`, which we can get in the normal ways:++```haskell+import Effectful.PostgreSQL as EP+import qualified Database.PostgreSQL.Simple as PSQL++usingConnection :: IO ()+usingConnection =+ bracket (PSQL.connectPostgreSQL "") PSQL.close $ \conn ->+ runEff . EP.runWithconnection conn $ insertAndListCarefully++usingConnectInfo :: IO ()+usingConnectInfo =+ runEff . EP.runWithconnectInfo PSQL.defaultConnectInfo $ insertAndListCarefully+```++Alternatively, we can use a connection pool (from [resource-pool](https://hackage.haskell.org/package/resource-pool)+and [unliftio-pool](https://hackage.haskell.org/package/unliftio-pool)), which is much better suited to+long-running processes like servers.++```haskell+import Effectful.PostgreSQL as EP+import qualified Database.PostgreSQL.Simple as PSQL+import qualified UnliftIO.Pool as P++usingConnectionPool :: IO ()+usingConnectionPool = do+ poolCfg <- P.mkDefaultPoolConfig (PSQL.connectPostgreSQL "") PSQL.close 5.0 10+ pool <- P.newPool poolCfg+ runEff . EP.runWithconnectionPool pool $ insertAndListCarefully+```
+ effectful-postgresql.cabal view
@@ -0,0 +1,81 @@+cabal-version: 3.0+name: effectful-postgresql+version: 0.1.0.0+synopsis:+ effectful support for mid-level PostgreSQL operations.+description:+ See the README for an overview, or the documentation in 'Effectful.PostgreSQL'.+license: BSD-3-Clause+license-file: LICENSE+author: Frederick Pringle+maintainer: frederick.pringle@fpringle.com+copyright: Copyright(c) Frederick Pringle 2025+homepage: https://github.com/fpringle/effectful-postgresql+build-type: Simple+category: Database+extra-doc-files: README.md+ CHANGELOG.md++tested-with:+ GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.4+ , GHC == 9.2.8+ , GHC == 9.4.2+ , GHC == 9.4.5+ , GHC == 9.6.1+ , GHC == 9.6.7+ , GHC == 9.8.2+ , GHC == 9.10.2++flag enable-pool+ description: Enable support for connection pools using unliftio-pool.+ You can disable this for a lighter dependency footprint if+ you don't need support for connection pools.+ default: True+ manual: False++common warnings+ ghc-options: -Wall -Wno-unused-do-bind -Wunused-packages++ if flag(enable-pool)+ cpp-options: -DPOOL++common deps+ build-depends:+ , base >= 4 && < 5+ , effectful-core >= 2.3 && < 2.6+ , effectful-th >= 1.0.0.1 && < 1.0.1+ , postgresql-simple >= 0.7 && < 0.8++ if flag(enable-pool)+ build-depends:+ , unliftio-pool >= 0.4.1 && < 0.5++common extensions+ default-extensions:+ DataKinds+ FlexibleContexts+ GADTs+ LambdaCase+ RankNTypes+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators++library+ import:+ warnings+ , deps+ , extensions+ exposed-modules:+ Effectful.PostgreSQL+ Effectful.PostgreSQL.Connection+ if flag(enable-pool)+ exposed-modules:+ Effectful.PostgreSQL.Connection.Pool+ -- other-extensions:+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Effectful/PostgreSQL.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE CPP #-}++module Effectful.PostgreSQL+ ( -- * Effect+ WithConnection+ , withConnection++ -- ** Interpreters+ , runWithConnection++#if POOL+ , runWithConnectionPool+#endif++ -- * Lifted versions of functions from Database.PostgreSQL.Simple++ -- ** Queries that return results+ , query+ , query_+ , queryWith+ , queryWith_++ -- ** Statements that do not return results+ , execute+ , execute_+ , executeMany++ -- ** Transaction handling+ , withTransaction+ , withSavepoint+ , begin+ , commit+ , rollback++ -- ** Queries that stream results+ , fold+ , foldWithOptions+ , fold_+ , foldWithOptions_+ , forEach+ , forEach_+ , returning+ , foldWith+ , foldWithOptionsAndParser+ , foldWith_+ , foldWithOptionsAndParser_+ , forEachWith+ , forEachWith_+ , returningWith+ )+where++import Data.Int (Int64)+import qualified Database.PostgreSQL.Simple as PSQL+import qualified Database.PostgreSQL.Simple.FromRow as PSQL+import Effectful+import Effectful.PostgreSQL.Connection as Conn+import GHC.Stack+#if POOL+import Effectful.PostgreSQL.Connection.Pool as Pool+#endif++-- | Lifted 'PSQL.query'.+query ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q, PSQL.FromRow r) =>+ PSQL.Query ->+ q ->+ Eff es [r]+query q row = withConnection $ \conn -> liftIO (PSQL.query conn q row)++-- | Lifted 'PSQL.query_'.+query_ ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow r) =>+ PSQL.Query ->+ Eff es [r]+query_ row = withConnection $ \conn -> liftIO (PSQL.query_ conn row)++-- | Lifted 'PSQL.queryWith'.+queryWith ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q) =>+ PSQL.RowParser r ->+ PSQL.Query ->+ q ->+ Eff es [r]+queryWith parser q row =+ withConnection $ \conn -> liftIO (PSQL.queryWith parser conn q row)++-- | Lifted 'PSQL.queryWith_'.+queryWith_ ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ PSQL.RowParser r ->+ PSQL.Query ->+ Eff es [r]+queryWith_ parser row =+ withConnection $ \conn -> liftIO (PSQL.queryWith_ parser conn row)++-- | Lifted 'PSQL.execute'.+execute ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q) =>+ PSQL.Query ->+ q ->+ Eff es Int64+execute q row = withConnection $ \conn -> liftIO (PSQL.execute conn q row)++-- | Lifted 'PSQL.execute_'.+execute_ ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ PSQL.Query ->+ Eff es Int64+execute_ row = withConnection $ \conn -> liftIO (PSQL.execute_ conn row)++-- | Lifted 'PSQL.executeMany'.+executeMany ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q) =>+ PSQL.Query ->+ [q] ->+ Eff es Int64+executeMany q rows = withConnection $ \conn -> liftIO (PSQL.executeMany conn q rows)++-- | Lifted 'PSQL.withTransaction'.+withTransaction ::+ (HasCallStack, WithConnection :> es, IOE :> es) => Eff es a -> Eff es a+withTransaction f =+ unliftWithConn $ \conn unlift ->+ PSQL.withTransaction conn (unlift f)++-- | Lifted 'PSQL.withSavepoint'.+withSavepoint :: (HasCallStack, WithConnection :> es, IOE :> es) => Eff es a -> Eff es a+withSavepoint f =+ unliftWithConn $ \conn unlift ->+ PSQL.withSavepoint conn (unlift f)++-- | Lifted 'PSQL.begin'.+begin :: (HasCallStack, WithConnection :> es, IOE :> es) => Eff es ()+begin = withConnection $ liftIO . PSQL.begin++-- | Lifted 'PSQL.commit'.+commit :: (HasCallStack, WithConnection :> es, IOE :> es) => Eff es ()+commit = withConnection $ liftIO . PSQL.commit++-- | Lifted 'PSQL.rollback'.+rollback :: (HasCallStack, WithConnection :> es, IOE :> es) => Eff es ()+rollback = withConnection $ liftIO . PSQL.rollback++(...) :: (a -> b) -> (t1 -> t2 -> a) -> t1 -> t2 -> b+unlift ... f = \a' row -> unlift $ f a' row++unliftWithConn ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ (PSQL.Connection -> (forall b. Eff es b -> IO b) -> IO a) ->+ Eff es a+unliftWithConn f =+ withConnection $ \conn ->+ withSeqEffToIO $ \unlift ->+ liftIO $ f conn unlift+{-# INLINE unliftWithConn #-}++-- | Lifted 'PSQL.fold'.+fold ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow row, PSQL.ToRow params) =>+ PSQL.Query ->+ params ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+fold q params a f =+ unliftWithConn $ \conn unlift ->+ PSQL.fold conn q params a (unlift ... f)++-- | Lifted 'PSQL.foldWithOptions'.+foldWithOptions ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow row, PSQL.ToRow params) =>+ PSQL.FoldOptions ->+ PSQL.Query ->+ params ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWithOptions opts q params a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWithOptions opts conn q params a (unlift ... f)++-- | Lifted 'PSQL.fold_'.+fold_ ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow row) =>+ PSQL.Query ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+fold_ q a f =+ unliftWithConn $ \conn unlift ->+ PSQL.fold_ conn q a (unlift ... f)++-- | Lifted 'PSQL.foldWithOptions_'.+foldWithOptions_ ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow row) =>+ PSQL.FoldOptions ->+ PSQL.Query ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWithOptions_ opts q a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWithOptions_ opts conn q a (unlift ... f)++-- | Lifted 'PSQL.forEach'.+forEach ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow r, PSQL.ToRow q) =>+ PSQL.Query ->+ q ->+ (r -> Eff es ()) ->+ Eff es ()+forEach q row forR =+ unliftWithConn $ \conn unlift ->+ PSQL.forEach conn q row (unlift . forR)++-- | Lifted 'PSQL.forEach_'.+forEach_ ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.FromRow r) =>+ PSQL.Query ->+ (r -> Eff es ()) ->+ Eff es ()+forEach_ q forR =+ unliftWithConn $ \conn unlift ->+ PSQL.forEach_ conn q (unlift . forR)++-- | Lifted 'PSQL.returning'.+returning ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q, PSQL.FromRow r) =>+ PSQL.Query ->+ [q] ->+ Eff es [r]+returning q rows = withConnection $ \conn -> liftIO $ PSQL.returning conn q rows++-- | Lifted 'PSQL.foldWith'.+foldWith ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow params) =>+ PSQL.RowParser row ->+ PSQL.Query ->+ params ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWith parser q params a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWith parser conn q params a (unlift ... f)++-- | Lifted 'PSQL.foldWithOptionsAndParser'.+foldWithOptionsAndParser ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow params) =>+ PSQL.FoldOptions ->+ PSQL.RowParser row ->+ PSQL.Query ->+ params ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWithOptionsAndParser opts parser q params a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWithOptionsAndParser opts parser conn q params a (unlift ... f)++-- | Lifted 'PSQL.foldWith_'.+foldWith_ ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ PSQL.RowParser row ->+ PSQL.Query ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWith_ parser q a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWith_ parser conn q a (unlift ... f)++-- | Lifted 'PSQL.foldWithOptionsAndParser_'.+foldWithOptionsAndParser_ ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ PSQL.FoldOptions ->+ PSQL.RowParser row ->+ PSQL.Query ->+ a ->+ (a -> row -> Eff es a) ->+ Eff es a+foldWithOptionsAndParser_ opts parser q a f =+ unliftWithConn $ \conn unlift ->+ PSQL.foldWithOptionsAndParser_ opts parser conn q a (unlift ... f)++-- | Lifted 'PSQL.forEachWith'.+forEachWith ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q) =>+ PSQL.RowParser r ->+ PSQL.Query ->+ q ->+ (r -> Eff es ()) ->+ Eff es ()+forEachWith parser q row forR =+ unliftWithConn $ \conn unlift ->+ PSQL.forEachWith parser conn q row (unlift . forR)++-- | Lifted 'PSQL.forEachWith_'.+forEachWith_ ::+ (HasCallStack, WithConnection :> es, IOE :> es) =>+ PSQL.RowParser r ->+ PSQL.Query ->+ (r -> Eff es ()) ->+ Eff es ()+forEachWith_ parser row forR =+ unliftWithConn $ \conn unlift ->+ PSQL.forEachWith_ parser conn row (unlift . forR)++-- | Lifted 'PSQL.returningWith'.+returningWith ::+ (HasCallStack, WithConnection :> es, IOE :> es, PSQL.ToRow q) =>+ PSQL.RowParser r ->+ PSQL.Query ->+ [q] ->+ Eff es [r]+returningWith parser q rows =+ withConnection $ \conn -> liftIO $ PSQL.returningWith parser conn q rows
+ src/Effectful/PostgreSQL/Connection.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE TemplateHaskell #-}++module Effectful.PostgreSQL.Connection+ ( -- * Effect+ WithConnection (..)+ , withConnection++ -- * Interpret with a single Connection+ , runWithConnection+ , runWithConnectInfo+ )+where++import qualified Database.PostgreSQL.Simple as PSQL+import Effectful+import Effectful.Dispatch.Dynamic+import Effectful.TH++{- | A dynamic effect that lets us use a database 'PSQL.Connection',+without specifying __how__ that connection is supplied.++For example, we might want to just provide a connection and let the interpreter+use that for the whole procedure (see 'Effectful.PostgreSQL.Connection.runWithConnection').++Or, we might want to create a connection pool which provides connections when+the interpreter asks for them (see "Effectful.PostgreSQL.Connection.Pool").+-}+data WithConnection :: Effect where+ -- | Use a 'PSQL.Connection' provided by an interpreter.+ WithConnection :: (PSQL.Connection -> m a) -> WithConnection m a++makeEffect ''WithConnection++{- | Run a t'WithConnection' effect by simply supplying a 'PSQL.Connection'.+The connection will be kept alive for the whole duration of the procedure,+which might not be want you want for long-running processes. If so, see+"Effectful.PostgreSQL.Connection.Pool".+-}+runWithConnection ::+ (HasCallStack) => PSQL.Connection -> Eff (WithConnection : es) a -> Eff es a+runWithConnection conn = interpret $ \env -> \case+ WithConnection f ->+ localSeqUnlift env $ \unlift -> unlift $ f conn++{- | Run a t'WithConnection' effect using a 'PSQL.ConnectInfo'.+The 'PSQL.ConnectInfo' will be used to create a 'PSQL.Connection' which will be+kept alive for the whole duration of the procedure, which might not be want you want+for long-running processes. If so, see "Effectful.PostgreSQL.Connection.Pool".++'PSQL.withConnect' will handle opening and closing the 'PSQL.Connection'.+-}+runWithConnectInfo ::+ (HasCallStack, IOE :> es) => PSQL.ConnectInfo -> Eff (WithConnection : es) a -> Eff es a+runWithConnectInfo connInfo eff =+ withSeqEffToIO $ \unlift ->+ liftIO . PSQL.withConnect connInfo $ \conn ->+ unlift $ runWithConnection conn eff
+ src/Effectful/PostgreSQL/Connection/Pool.hs view
@@ -0,0 +1,28 @@+module Effectful.PostgreSQL.Connection.Pool+ ( -- * Interpret with a Connection pool+ runWithConnectionPool++ -- * Re-export+ , module Pool+ )+where++import qualified Database.PostgreSQL.Simple as PSQL+import Effectful+import Effectful.Dispatch.Dynamic+import Effectful.PostgreSQL.Connection+import UnliftIO.Pool as Pool++{- | Rather than keeping one connection alive and re-using it for the whole+process, we might want to create a 'Pool' of connections and only "ask" for+one when we need it. This function uses "UnliftIO.Pool" to do just that.+-}+runWithConnectionPool ::+ (HasCallStack, IOE :> es) =>+ Pool.Pool PSQL.Connection ->+ Eff (WithConnection : es) a ->+ Eff es a+runWithConnectionPool pool = interpret $ \env -> \case+ WithConnection f ->+ localSeqUnlift env $ \unlift -> do+ Pool.withResource pool $ unlift . f