Skip to content

Commit 018e4ea

Browse files
author
Eric Easley
committed
Push to backends
1 parent e73e1e2 commit 018e4ea

4 files changed

Lines changed: 32 additions & 32 deletions

File tree

‎persistent-mysql/Database/Persist/MySQL.hs‎

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Data.Fixed (Pico)
3131
import Data.Function (on)
3232
import Data.IORef
3333
import Data.List (find, intercalate, sort, groupBy)
34+
import Data.Pool (Pool)
3435
import Data.Text (Text, pack)
3536
import qualified Data.Text.IO as T
3637
import Text.Read (readMaybe)
@@ -46,6 +47,7 @@ import qualified Data.Text as T
4647
import qualified Data.Text.Encoding as T
4748

4849
import Database.Persist.Sql
50+
import Database.Persist.Sql.Types.Internal (mkPersistBackend)
4951
import Data.Int (Int64)
5052

5153
import qualified Database.MySQL.Simple as MySQL
@@ -58,17 +60,16 @@ import qualified Database.MySQL.Base.Types as MySQLBase
5860
import Control.Monad.Trans.Control (MonadBaseControl)
5961
import Control.Monad.Trans.Resource (runResourceT)
6062

61-
6263
-- | Create a MySQL connection pool and run the given action.
6364
-- The pool is properly released after the action finishes using
6465
-- it. Note that you should not use the given 'ConnectionPool'
6566
-- outside the action since it may be already been released.
66-
withMySQLPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) =>
67-
MySQL.ConnectInfo
67+
withMySQLPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
68+
=> MySQL.ConnectInfo
6869
-- ^ Connection information.
6970
-> Int
7071
-- ^ Number of connections to be kept open in the pool.
71-
-> (ConnectionPool -> m a)
72+
-> (Pool backend -> m a)
7273
-- ^ Action to be executed that uses the connection pool.
7374
-> m a
7475
withMySQLPool ci = withSqlPool $ open' ci
@@ -77,34 +78,34 @@ withMySQLPool ci = withSqlPool $ open' ci
7778
-- | Create a MySQL connection pool. Note that it's your
7879
-- responsibility to properly close the connection pool when
7980
-- unneeded. Use 'withMySQLPool' for automatic resource control.
80-
createMySQLPool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) =>
81-
MySQL.ConnectInfo
81+
createMySQLPool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
82+
=> MySQL.ConnectInfo
8283
-- ^ Connection information.
8384
-> Int
8485
-- ^ Number of connections to be kept open in the pool.
85-
-> m ConnectionPool
86+
-> m (Pool backend)
8687
createMySQLPool ci = createSqlPool $ open' ci
8788

8889

8990
-- | Same as 'withMySQLPool', but instead of opening a pool
9091
-- of connections, only one connection is opened.
91-
withMySQLConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) =>
92-
MySQL.ConnectInfo
92+
withMySQLConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
93+
=> MySQL.ConnectInfo
9394
-- ^ Connection information.
94-
-> (SqlBackend -> m a)
95+
-> (backend -> m a)
9596
-- ^ Action to be executed that uses the connection.
9697
-> m a
9798
withMySQLConn = withSqlConn . open'
9899

99100

100101
-- | Internal function that opens a connection to the MySQL
101102
-- server.
102-
open' :: MySQL.ConnectInfo -> LogFunc -> IO SqlBackend
103+
open' :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend) => MySQL.ConnectInfo -> LogFunc -> IO backend
103104
open' ci logFunc = do
104105
conn <- MySQL.connect ci
105106
MySQLBase.autocommit conn False -- disable autocommit!
106107
smap <- newIORef $ Map.empty
107-
return SqlBackend
108+
return . mkPersistBackend $ SqlBackend
108109
{ connPrepare = prepare' conn
109110
, connStmtMap = smap
110111
, connInsertSql = insertSql'

‎persistent-mysql/persistent-mysql.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ library
4141
, conduit >= 0.5.3
4242
, resourcet >= 0.4.10
4343
, monad-logger
44+
, resource-pool
4445
exposed-modules: Database.Persist.MySQL
4546
ghc-options: -Wall
4647

‎persistent-postgresql/Database/Persist/Postgresql.hs‎

Lines changed: 17 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ module Database.Persist.Postgresql
2525

2626
import Database.Persist.Sql
2727
import Database.Persist.Sql.Util (dbIdColumnsEsc)
28+
import Database.Persist.Sql.Types.Internal (mkPersistBackend)
2829
import Data.Fixed (Pico)
2930

3031
import qualified Database.PostgreSQL.Simple as PG
@@ -73,6 +74,7 @@ import Data.Acquire (Acquire, mkAcquire, with)
7374
import System.Environment (getEnvironment)
7475
import Data.Int (Int64)
7576
import Data.Monoid ((<>))
77+
import Data.Pool (Pool)
7678
import Data.Time (utc, localTimeToUTC)
7779

7880
-- | A @libpq@ connection string. A simple example of connection
@@ -89,13 +91,13 @@ type ConnectionString = ByteString
8991
-- finishes using it. Note that you should not use the given
9092
-- 'ConnectionPool' outside the action since it may be already
9193
-- been released.
92-
withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m)
94+
withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
9395
=> ConnectionString
9496
-- ^ Connection string to the database.
9597
-> Int
9698
-- ^ Number of connections to be kept open in
9799
-- the pool.
98-
-> (ConnectionPool -> m a)
100+
-> (Pool backend -> m a)
99101
-- ^ Action to be executed that uses the
100102
-- connection pool.
101103
-> m a
@@ -106,13 +108,13 @@ withPostgresqlPool ci = withSqlPool $ open' (const $ return ()) ci
106108
-- responsibility to properly close the connection pool when
107109
-- unneeded. Use 'withPostgresqlPool' for an automatic resource
108110
-- control.
109-
createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
111+
createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
110112
=> ConnectionString
111113
-- ^ Connection string to the database.
112114
-> Int
113115
-- ^ Number of connections to be kept open
114116
-- in the pool.
115-
-> m ConnectionPool
117+
-> m (Pool backend)
116118
createPostgresqlPool = createPostgresqlPoolModified (const $ return ())
117119

118120
-- | Same as 'createPostgresqlPool', but additionally takes a callback function
@@ -124,32 +126,33 @@ createPostgresqlPool = createPostgresqlPoolModified (const $ return ())
124126
--
125127
-- Since 2.1.3
126128
createPostgresqlPoolModified
127-
:: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
129+
:: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
128130
=> (PG.Connection -> IO ()) -- ^ action to perform after connection is created
129131
-> ConnectionString -- ^ Connection string to the database.
130132
-> Int -- ^ Number of connections to be kept open in the pool.
131-
-> m ConnectionPool
133+
-> m (Pool backend)
132134
createPostgresqlPoolModified modConn ci = createSqlPool $ open' modConn ci
133135

134136
-- | Same as 'withPostgresqlPool', but instead of opening a pool
135137
-- of connections, only one connection is opened.
136-
withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
137-
=> ConnectionString -> (SqlBackend -> m a) -> m a
138+
withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
139+
=> ConnectionString -> (backend -> m a) -> m a
138140
withPostgresqlConn = withSqlConn . open' (const $ return ())
139141

140-
open' :: (PG.Connection -> IO ())
141-
-> ConnectionString -> LogFunc -> IO SqlBackend
142+
open'
143+
:: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend)
144+
=> (PG.Connection -> IO ()) -> ConnectionString -> LogFunc -> IO backend
142145
open' modConn cstr logFunc = do
143146
conn <- PG.connectPostgreSQL cstr
144147
modConn conn
145148
openSimpleConn logFunc conn
146149

147150

148151
-- | Generate a 'Connection' from a 'PG.Connection'
149-
openSimpleConn :: LogFunc -> PG.Connection -> IO SqlBackend
152+
openSimpleConn :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend) => LogFunc -> PG.Connection -> IO backend
150153
openSimpleConn logFunc conn = do
151154
smap <- newIORef $ Map.empty
152-
return SqlBackend
155+
return . mkPersistBackend $ SqlBackend
153156
{ connPrepare = prepare' conn
154157
, connStmtMap = smap
155158
, connInsertSql = insertSql'
@@ -899,18 +902,12 @@ showAlter table (_, DropReference cname) = T.concat
899902

900903
-- | get the SQL string for the table that a PeristEntity represents
901904
-- Useful for raw SQL queries
902-
tableName :: forall record.
903-
( PersistEntity record
904-
, PersistEntityBackend record ~ SqlBackend
905-
) => record -> Text
905+
tableName :: (PersistEntity record) => record -> Text
906906
tableName = escape . tableDBName
907907

908908
-- | get the SQL string for the field that an EntityField represents
909909
-- Useful for raw SQL queries
910-
fieldName :: forall record typ.
911-
( PersistEntity record
912-
, PersistEntityBackend record ~ SqlBackend
913-
) => EntityField record typ -> Text
910+
fieldName :: (PersistEntity record) => EntityField record typ -> Text
914911
fieldName = escape . fieldDBName
915912

916913
escape :: DBName -> Text

‎persistent-postgresql/persistent-postgresql.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ library
3030
, conduit >= 0.5.3
3131
, resourcet >= 1.1
3232
, monad-logger >= 0.3.4
33+
, resource-pool
3334
exposed-modules: Database.Persist.Postgresql
3435
ghc-options: -Wall
3536

0 commit comments

Comments
 (0)