@@ -33,8 +33,7 @@ a `MonadPQ` constraint for running a `Manipulation` or `Query`.
3333
3434module Squeal.PostgreSQL.PQ
3535 ( -- * Connection
36− Connection (Connection, unConnection)
37− , connectdb
36+ connectdb
3837 , finish
3938 , withConnection
4039 -- * PQ
@@ -62,6 +61,8 @@ module Squeal.PostgreSQL.PQ
6261 , nextRow
6362 , firstRow
6463 , liftResult
64+ -- * Re-export
65+ , LibPQ.Connection
6566 ) where
6667
6768import Control.Exception.Lifted
@@ -100,11 +101,6 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict
100101import qualified Control.Monad.Trans.RWS.Lazy as Lazy
101102import qualified Control.Monad.Trans.RWS.Strict as Strict
102103
103−-- | A `Connection` consists of a `Database.PostgreSQL.LibPQ`
104−-- `Database.PastgreSQL.LibPQ.Connection` and a phantom `TablesType`
105−newtype Connection (schema :: TablesType) =
106− Connection { unConnection :: LibPQ.Connection }
107−
108104{- | Makes a new connection to the database server.
109105
110106This function opens a new database connection using the parameters taken
@@ -134,19 +130,19 @@ connectdb
134130 :: forall schema io
135131 . MonadBase IO io
136132 => ByteString -- ^ conninfo
137− -> io (Connection schema)
138−connectdb = fmap Connection . liftBase . LibPQ.connectdb
133+ -> io (K LibPQ.Connection schema)
134+connectdb = fmap K . liftBase . LibPQ.connectdb
139135
140136-- | Closes the connection to the server.
141−finish :: MonadBase IO io => Connection schema -> io ()
142−finish = liftBase . LibPQ.finish . unConnection
137+finish :: MonadBase IO io => K LibPQ.Connection schema -> io ()
138+finish = liftBase . LibPQ.finish . unK
143139
144140-- | Do `connectdb` and `finish` before and after a computation.
145141withConnection
146142 :: forall schema0 schema1 io x
147143 . MonadBaseControl IO io
148144 => ByteString
149− -> (Connection schema0 -> io (x, Connection schema1))
145+ -> (K LibPQ.Connection schema0 -> io (x, K LibPQ.Connection schema1))
150146 -> io x
151147withConnection connString action = do
152148 (x, _conn) <- bracket (connectdb connString) finish action
@@ -159,16 +155,20 @@ newtype PQ
159155 (schema1 :: TablesType)
160156 (m :: Type -> Type)
161157 (x :: Type) =
162− PQ { runPQ :: Connection schema0 -> m (x, Connection schema1) }
163− deriving Functor
158+ PQ { runPQ :: K LibPQ.Connection schema0 -> m (K x schema1) }
159+
160+instance Monad m => Functor (PQ schema0 schema1 m) where
161+ fmap f (PQ pq) = PQ $ \ conn -> do
162+ K x <- pq conn
163+ return $ K (f x)
164164
165165-- | Run a `PQ` and discard the result but keep the `Connection`.
166166execPQ
167167 :: Functor m
168168 => PQ schema0 schema1 m x
169− -> Connection schema0
170− -> m (Connection schema1)
171−execPQ (PQ pq) = fmap snd . pq
169+ -> K LibPQ.Connection schema0
170+ -> m (K LibPQ.Connection schema1)
171+execPQ (PQ pq) conn = fmap (mapKK (\ _ -> unK conn)) $ pq conn
172172
173173-- | indexed analog of `<*>`
174174pqAp
@@ -177,9 +177,9 @@ pqAp
177177 -> PQ schema1 schema2 m x
178178 -> PQ schema0 schema2 m y
179179pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
180− (f', conn') <- f conn
181− (x', conn'') <- x conn'
182− return (f' x', conn'')
180+ K f' <- f conn
181+ K x' <- x (K (unK conn))
182+ return $ K (f' x')
183183
184184-- | indexed analog of `join`
185185pqJoin
@@ -194,8 +194,8 @@ pqBind
194194 -> PQ schema0 schema1 m x
195195 -> PQ schema0 schema2 m y
196196pqBind f (PQ x) = PQ $ \ conn -> do
197− (x', conn') <- x conn
198− runPQ (f x') conn'
197+ K x' <- x conn
198+ runPQ (f x') (K (unK conn))
199199
200200-- | indexed analog of flipped `>>`
201201pqThen
@@ -212,12 +212,12 @@ define
212212 :: MonadBase IO io
213213 => Definition schema0 schema1
214214 -> PQ schema0 schema1 io (Result '[])
215−define (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
215+define (UnsafeDefinition q) = PQ $ \ (K conn) -> do
216216 resultMaybe <- liftBase $ LibPQ.exec conn q
217217 case resultMaybe of
218218 Nothing -> error
219219 "define: LibPQ.exec returned no results"
220− Just result -> return (Result result, Connection conn)
220+ Just result -> return $ K (Result result)
221221
222222-- | Chain together `define` actions.
223223thenDefine
@@ -342,7 +342,7 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
342342
343343 manipulateParams
344344 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =
345− PQ $ \ (Connection conn) -> do
345+ PQ $ \ (K conn) -> do
346346 let
347347 toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)
348348 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
@@ -350,11 +350,11 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
350350 case resultMaybe of
351351 Nothing -> error
352352 "manipulateParams: LibPQ.execParams returned no results"
353− Just result -> return (Result result, Connection conn)
353+ Just result -> return $ K (Result result)
354354
355355 traversePrepared
356356 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
357− PQ $ \ (Connection conn) -> liftBase $ do
357+ PQ $ \ (K conn) -> liftBase $ do
358358 let temp = "temporary_statement"
359359 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
360360 case prepResultMaybe of
@@ -381,11 +381,11 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
381381 status <- LibPQ.resultStatus deallocResult
382382 unless (status == LibPQ.CommandOk) . error $
383383 "traversePrepared: DEALLOCATE status " <> show status
384− return (results, Connection conn)
384+ return (K results)
385385
386386 traversePrepared_
387387 (UnsafeManipulation q :: Manipulation schema xs '[]) (list :: list x) =
388− PQ $ \ (Connection conn) -> liftBase $ do
388+ PQ $ \ (K conn) -> liftBase $ do
389389 let temp = "temporary_statement"
390390 prepResultMaybe <- LibPQ.prepare conn temp q Nothing
391391 case prepResultMaybe of
@@ -412,11 +412,11 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
412412 status <- LibPQ.resultStatus deallocResult
413413 unless (status == LibPQ.CommandOk) . error $
414414 "traversePrepared: DEALLOCATE status " <> show status
415− return ((), Connection conn)
415+ return (K ())
416416
417− liftPQ pq = PQ $ \ (Connection conn) -> do
417+ liftPQ pq = PQ $ \ (K conn) -> do
418418 y <- liftBase $ pq conn
419− return (y, Connection conn)
419+ return (K y)
420420
421421instance MonadPQ schema m => MonadPQ schema (IdentityT m)
422422instance MonadPQ schema m => MonadPQ schema (ReaderT r m)
@@ -432,7 +432,7 @@ instance MonadPQ schema m => MonadPQ schema (ContT r m)
432432instance MonadPQ schema m => MonadPQ schema (ListT m)
433433
434434instance Monad m => Applicative (PQ schema schema m) where
435− pure x = PQ $ \ conn -> pure (x, conn)
435+ pure x = PQ $ \ _conn -> pure (K x)
436436 (<*>) = pqAp
437437
438438instance Monad m => Monad (PQ schema schema m) where
@@ -440,24 +440,24 @@ instance Monad m => Monad (PQ schema schema m) where
440440 (>>=) = flip pqBind
441441
442442instance MonadTrans (PQ schema schema) where
443− lift m = PQ $ \ conn -> do
443+ lift m = PQ $ \ _conn -> do
444444 x <- m
445− return (x, conn)
445+ return (K x)
446446
447447instance MonadBase b m => MonadBase b (PQ schema schema m) where
448448 liftBase = lift . liftBase
449449
450450-- | A snapshot of the state of a `PQ` computation.
451451type PQRun schema =
452− forall m x. Monad m => PQ schema schema m x -> m (x, Connection schema)
452+ forall m x. Monad m => PQ schema schema m x -> m (K x schema)
453453
454454-- | Helper function in defining `MonadBaseControl` instance for `PQ`.
455455pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
456456pqliftWith f = PQ $ \ conn ->
457− fmap (\ x -> (x, conn)) (f $ \ pq -> runPQ pq conn)
457+ fmap K (f $ \ pq -> runPQ pq conn)
458458
459459instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
460− type StM (PQ schema schema m) x = StM m (x, Connection schema)
460+ type StM (PQ schema schema m) x = StM m (K x schema)
461461 liftBaseWith f =
462462 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
463463 restoreM = PQ . const . restoreM