@@ -50,7 +50,6 @@ module Squeal.PostgreSQL.PQ
51 , pqliftWith
51 , pqliftWith
52 -- * Result
52 -- * Result
53− , Result (Result, unResult)
54 , RowNumber (RowNumber, unRowNumber)
53 , RowNumber (RowNumber, unRowNumber)
55 , ColumnNumber (UnsafeColumnNumber, getColumnNumber)
54 , ColumnNumber (UnsafeColumnNumber, getColumnNumber)
56 , HasColumnNumber (columnNumber)
55 , HasColumnNumber (columnNumber)
@@ -211,20 +210,20 @@ pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
212 :: MonadBase IO io
211 :: MonadBase IO io
213 => Definition schema0 schema1
212 => Definition schema0 schema1
214− -> PQ schema0 schema1 io (Result '[])
213+ -> PQ schema0 schema1 io (K LibPQ.Result '[])
215define (UnsafeDefinition q) = PQ $ \ (K conn) -> do
214define (UnsafeDefinition q) = PQ $ \ (K conn) -> do
216 resultMaybe <- liftBase $ LibPQ.exec conn q
215 resultMaybe <- liftBase $ LibPQ.exec conn q
217 case resultMaybe of
216 case resultMaybe of
218 Nothing -> error
217 Nothing -> error
219 "define: LibPQ.exec returned no results"
218 "define: LibPQ.exec returned no results"
220− Just result -> return $ K (Result result)
219+ Just result -> return $ K (K result)
222-- | Chain together `define` actions.
221-- | Chain together `define` actions.
223thenDefine
222thenDefine
224 :: MonadBase IO io
223 :: MonadBase IO io
225 => Definition schema1 schema2
224 => Definition schema1 schema2
226 -> PQ schema0 schema1 io x
225 -> PQ schema0 schema1 io x
227− -> PQ schema0 schema2 io (Result '[])
226+ -> PQ schema0 schema2 io (K LibPQ.Result '[])
228thenDefine = pqThen . define
227thenDefine = pqThen . define
230{- | `MonadPQ` is an `mtl` style constraint, similar to
229{- | `MonadPQ` is an `mtl` style constraint, similar to
@@ -264,41 +263,41 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
264 :: ToParams x params
263 :: ToParams x params
265 => Manipulation schema params ys
264 => Manipulation schema params ys
266 -- ^ `insertInto`, `update` or `deleteFrom`
265 -- ^ `insertInto`, `update` or `deleteFrom`
267− -> x -> pq (Result ys)
266+ -> x -> pq (K LibPQ.Result ys)
268 default manipulateParams
267 default manipulateParams
269 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
268 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
270 => ToParams x params
269 => ToParams x params
271 => Manipulation schema params ys
270 => Manipulation schema params ys
272 -- ^ `insertInto`, `update` or `deleteFrom`
271 -- ^ `insertInto`, `update` or `deleteFrom`
273− -> x -> pq (Result ys)
272+ -> x -> pq (K LibPQ.Result ys)
274 manipulateParams manipulation params = lift $
273 manipulateParams manipulation params = lift $
275 manipulateParams manipulation params
274 manipulateParams manipulation params
277− manipulate :: Manipulation schema '[] ys -> pq (Result ys)
276+ manipulate :: Manipulation schema '[] ys -> pq (K LibPQ.Result ys)
278 manipulate statement = manipulateParams statement ()
277 manipulate statement = manipulateParams statement ()
280 runQueryParams
279 runQueryParams
281 :: ToParams x params
280 :: ToParams x params
282 => Query schema params ys
281 => Query schema params ys
283 -- ^ `select` and friends
282 -- ^ `select` and friends
284− -> x -> pq (Result ys)
283+ -> x -> pq (K LibPQ.Result ys)
285 runQueryParams = manipulateParams . queryStatement
284 runQueryParams = manipulateParams . queryStatement
288 :: Query schema '[] ys
287 :: Query schema '[] ys
289 -- ^ `select` and friends
288 -- ^ `select` and friends
290− -> pq (Result ys)
289+ -> pq (K LibPQ.Result ys)
291 runQuery q = runQueryParams q ()
290 runQuery q = runQueryParams q ()
293 traversePrepared
292 traversePrepared
294 :: (ToParams x params, Traversable list)
293 :: (ToParams x params, Traversable list)
295 => Manipulation schema params ys
294 => Manipulation schema params ys
296 -- ^ `insertInto`, `update` or `deleteFrom`
295 -- ^ `insertInto`, `update` or `deleteFrom`
297− -> list x -> pq (list (Result ys))
296+ -> list x -> pq (list (K LibPQ.Result ys))
298 default traversePrepared
297 default traversePrepared
299 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
298 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
300 => (ToParams x params, Traversable list)
299 => (ToParams x params, Traversable list)
301− => Manipulation schema params ys -> list x -> pq (list (Result ys))
300+ => Manipulation schema params ys -> list x -> pq (list (K LibPQ.Result ys))
302 traversePrepared manipulation params = lift $
301 traversePrepared manipulation params = lift $
303 traversePrepared manipulation params
302 traversePrepared manipulation params
@@ -307,7 +306,7 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
307 => list x
306 => list x
308 -> Manipulation schema params ys
307 -> Manipulation schema params ys
309 -- ^ `insertInto`, `update` or `deleteFrom`
308 -- ^ `insertInto`, `update` or `deleteFrom`
310− -> pq (list (Result ys))
309+ -> pq (list (K LibPQ.Result ys))
311 forPrepared = flip traversePrepared
310 forPrepared = flip traversePrepared
313 traversePrepared_
312 traversePrepared_
@@ -350,7 +349,7 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
350 case resultMaybe of
349 case resultMaybe of
351 Nothing -> error
350 Nothing -> error
352 "manipulateParams: LibPQ.execParams returned no results"
351 "manipulateParams: LibPQ.execParams returned no results"
353− Just result -> return $ K (Result result)
352+ Just result -> return $ K (K result)
355 traversePrepared
354 traversePrepared
356 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
355 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
@@ -372,7 +371,7 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
372 case resultMaybe of
371 case resultMaybe of
373 Nothing -> error
372 Nothing -> error
374 "traversePrepared: LibPQ.execParams returned no results"
373 "traversePrepared: LibPQ.execParams returned no results"
375− Just result -> return $ Result result
374+ Just result -> return $ K result
376 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
375 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
377 case deallocResultMaybe of
376 case deallocResultMaybe of
378 Nothing -> error
377 Nothing -> error
@@ -462,12 +461,6 @@ instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
462 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
461 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
463 restoreM = PQ . const . restoreM
462 restoreM = PQ . const . restoreM
465−-- | Encapsulates the result of a squeal command run by @LibPQ@.
466−-- `Result`s are parameterized by a `ColumnsType` describing the column names
468−newtype Result (columns :: RelationType)
469− = Result { unResult :: LibPQ.Result }
471-- | Just newtypes around a `CInt`
464-- | Just newtypes around a `CInt`
472newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
465newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
@@ -494,12 +487,12 @@ getValue
494 :: (FromColumnValue colty y, MonadBase IO io)
487 :: (FromColumnValue colty y, MonadBase IO io)
495 => RowNumber -- ^ row
488 => RowNumber -- ^ row
496 -> ColumnNumber n columns colty -- ^ col
489 -> ColumnNumber n columns colty -- ^ col
497− -> Result columns -- ^ result
490+ -> K LibPQ.Result columns -- ^ result
500 (RowNumber r)
493 (RowNumber r)
501 (UnsafeColumnNumber c :: ColumnNumber n columns colty)
494 (UnsafeColumnNumber c :: ColumnNumber n columns colty)
502− (Result result)
495+ (K result)
503 = fmap (fromColumnValue @colty . K) $ liftBase $ do
496 = fmap (fromColumnValue @colty . K) $ liftBase $ do
504 numRows <- LibPQ.ntuples result
497 numRows <- LibPQ.ntuples result
505 when (numRows < r) $ error $
498 when (numRows < r) $ error $
@@ -512,10 +505,10 @@ getRow
512 :: (FromRow columns y, MonadBase IO io)
505 :: (FromRow columns y, MonadBase IO io)
513 => RowNumber
506 => RowNumber
515− -> Result columns
508+ -> K LibPQ.Result columns
516 -- ^ result
509 -- ^ result
518−getRow (RowNumber r) (Result result :: Result columns) = liftBase $ do
511+getRow (RowNumber r) (K result :: K LibPQ.Result columns) = liftBase $ do
519 numRows <- LibPQ.ntuples result
512 numRows <- LibPQ.ntuples result
520 when (numRows < r) $ error $
513 when (numRows < r) $ error $
521 "getRow: expected at least " <> show r <> "rows but only saw "
514 "getRow: expected at least " <> show r <> "rows but only saw "
@@ -527,8 +520,8 @@ getRow (RowNumber r) (Result result :: Result columns) = liftBase $ do
527 Just row -> return $ fromRow @columns row
520 Just row -> return $ fromRow @columns row
529-- | Returns the number of rows (tuples) in the query result.
522-- | Returns the number of rows (tuples) in the query result.
530−ntuples :: MonadBase IO io => Result columns -> io RowNumber
523+ntuples :: MonadBase IO io => K LibPQ.Result columns -> io RowNumber
531−ntuples (Result result) = liftBase $ RowNumber <$> LibPQ.ntuples result
524+ntuples (K result) = liftBase $ RowNumber <$> LibPQ.ntuples result
533-- | Intended to be used for unfolding in streaming libraries, `nextRow`
526-- | Intended to be used for unfolding in streaming libraries, `nextRow`
534-- takes a total number of rows (which can be found with `ntuples`)
527-- takes a total number of rows (which can be found with `ntuples`)
@@ -537,10 +530,10 @@ ntuples (Result result) = liftBase $ RowNumber <$> LibPQ.ntuples result
538 :: (FromRow columns y, MonadBase IO io)
531 :: (FromRow columns y, MonadBase IO io)
539 => RowNumber -- ^ total number of rows
532 => RowNumber -- ^ total number of rows
540− -> Result columns -- ^ result
533+ -> K LibPQ.Result columns -- ^ result
541 -> RowNumber -- ^ row number
534 -> RowNumber -- ^ row number
542 -> io (Maybe (RowNumber,y))
535 -> io (Maybe (RowNumber,y))
543−nextRow (RowNumber total) (Result result :: Result columns) (RowNumber r)
536+nextRow (RowNumber total) (K result :: K LibPQ.Result columns) (RowNumber r)
544 = liftBase $ if r >= total then return Nothing else do
537 = liftBase $ if r >= total then return Nothing else do
545 let len = fromIntegral (lengthSList (Proxy @columns))
538 let len = fromIntegral (lengthSList (Proxy @columns))
546 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
539 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
@@ -551,9 +544,9 @@ nextRow (RowNumber total) (Result result :: Result columns) (RowNumber r)
551-- | Get all rows from a `Result`.
544-- | Get all rows from a `Result`.
553 :: (FromRow columns y, MonadBase IO io)
546 :: (FromRow columns y, MonadBase IO io)
554− => Result columns -- ^ result
547+ => K LibPQ.Result columns -- ^ result
555 -> io [y]
548 -> io [y]
556−getRows (Result result :: Result columns) = liftBase $ do
549+getRows (K result :: K LibPQ.Result columns) = liftBase $ do
557 let len = fromIntegral (lengthSList (Proxy @columns))
550 let len = fromIntegral (lengthSList (Proxy @columns))
558 numRows <- LibPQ.ntuples result
551 numRows <- LibPQ.ntuples result
559 for [0 .. numRows - 1] $ \ r -> do
552 for [0 .. numRows - 1] $ \ r -> do
@@ -565,9 +558,9 @@ getRows (Result result :: Result columns) = liftBase $ do
565-- | Get the first row if possible from a `Result`.
558-- | Get the first row if possible from a `Result`.
567 :: (FromRow columns y, MonadBase IO io)
560 :: (FromRow columns y, MonadBase IO io)
568− => Result columns -- ^ result
561+ => K LibPQ.Result columns -- ^ result
569 -> io (Maybe y)
562 -> io (Maybe y)
570−firstRow (Result result :: Result columns) = liftBase $ do
563+firstRow (K result :: K LibPQ.Result columns) = liftBase $ do
571 numRows <- LibPQ.ntuples result
564 numRows <- LibPQ.ntuples result
572 if numRows <= 0 then return Nothing else do
565 if numRows <= 0 then return Nothing else do
573 let len = fromIntegral (lengthSList (Proxy @columns))
566 let len = fromIntegral (lengthSList (Proxy @columns))
@@ -580,5 +573,5 @@ firstRow (Result result :: Result columns) = liftBase $ do
580liftResult
573liftResult
581 :: MonadBase IO io
574 :: MonadBase IO io
582 => (LibPQ.Result -> IO x)
575 => (LibPQ.Result -> IO x)
583− -> Result results -> io x
576+ -> K LibPQ.Result results -> io x
584−liftResult f (Result result) = liftBase $ f result
577+liftResult f (K result) = liftBase $ f result