@@ -105,38 +105,38 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
105105
106106 manipulateParams
107107 :: ToParams x params
108− => Manipulation schema params ys -> x -> pq (Maybe (Result ys))
108+ => Manipulation schema params ys -> x -> pq (Result ys)
109109 default manipulateParams
110110 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
111111 => ToParams x params
112− => Manipulation schema params ys -> x -> pq (Maybe (Result ys))
112+ => Manipulation schema params ys -> x -> pq (Result ys)
113113 manipulateParams manipulation params = lift $
114114 manipulateParams manipulation params
115115
116− manipulate :: Manipulation schema '[] ys -> pq (Maybe (Result ys))
116+ manipulate :: Manipulation schema '[] ys -> pq (Result ys)
117117 manipulate statement = manipulateParams statement ()
118118
119119 queryParams
120120 :: ToParams x params
121− => Query schema params ys -> x -> pq (Maybe (Result ys))
121+ => Query schema params ys -> x -> pq (Result ys)
122122 queryParams = manipulateParams . queryStatement
123123
124− query :: Query schema '[] ys -> pq (Maybe (Result ys))
124+ query :: Query schema '[] ys -> pq (Result ys)
125125 query q = queryParams q ()
126126
127127 traversePrepared
128128 :: (ToParams x params, Traversable list)
129− => Manipulation schema params ys -> list x -> pq (list (Maybe (Result ys)))
129+ => Manipulation schema params ys -> list x -> pq (list (Result ys))
130130 default traversePrepared
131131 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
132132 => (ToParams x params, Traversable list)
133− => Manipulation schema params ys -> list x -> pq (list (Maybe (Result ys)))
133+ => Manipulation schema params ys -> list x -> pq (list (Result ys))
134134 traversePrepared manipulation params = lift $
135135 traversePrepared manipulation params
136136
137137 forPrepared
138138 :: (ToParams x params, Traversable list)
139− => list x -> Manipulation schema params ys -> pq (list (Maybe (Result ys)))
139+ => list x -> Manipulation schema params ys -> pq (list (Result ys))
140140 forPrepared = flip traversePrepared
141141
142142 traversePrepared_
@@ -154,7 +154,11 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
154154 => list x -> Manipulation schema params ys -> pq ()
155155 forPrepared_ = flip traversePrepared_
156156
157− connectPoll :: pq LibPQ.PollingStatus
157+ liftPQ :: (LibPQ.Connection -> IO a) -> pq a
158+ default liftPQ
159+ :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
160+ => (LibPQ.Connection -> IO a) -> pq a
161+ liftPQ = lift . liftPQ
158162
159163instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
160164
@@ -164,44 +168,71 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
164168 let
165169 toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)
166170 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
167− result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
168− return (Result <$> result, Connection conn)
171+ resultMaybe <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
172+ case resultMaybe of
173+ Nothing -> error
174+ "manipulateParams: LibPQ.execParams returned no results"
175+ Just result -> return (Result result, Connection conn)
169176
170177 traversePrepared
171178 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
172179 PQ $ \ (Connection conn) -> do
173180 let temp = "temporary_statement"
174− _prepResult <- liftBase $ LibPQ.prepare conn temp q Nothing
181+ prepResultMaybe <- liftBase $ LibPQ.prepare conn temp q Nothing
182+ case prepResultMaybe of
183+ Nothing -> error
184+ "traversePrepared: LibPQ.prepare returned no results"
185+ Just _prepResult -> return () -- todo: check status of prepResult
175186 results <- for list $ \ params -> do
176187 let
177188 toParam' bytes = (bytes,LibPQ.Binary)
178189 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
179− result <- liftBase $
190+ resultMaybe <- liftBase $
180191 LibPQ.execPrepared conn temp params' LibPQ.Binary
181− return $ Result <$> result
182− _deallocResult <- liftBase $
192+ case resultMaybe of
193+ Nothing -> error
194+ "traversePrepared: LibPQ.execParams returned no results"
195+ Just result -> return $ Result result
196+ deallocResultMaybe <- liftBase $
183197 LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
198+ case deallocResultMaybe of
199+ Nothing -> error
200+ "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
201+ Just _deallocResult -> return ()
202+ -- todo: check status of deallocResult
184203 return (results, Connection conn)
185204
186205 traversePrepared_
187206 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
188207 PQ $ \ (Connection conn) -> do
189208 let temp = "temporary_statement"
190− _prepResult <- liftBase $ LibPQ.prepare conn temp q Nothing
209+ prepResultMaybe <- liftBase $ LibPQ.prepare conn temp q Nothing
210+ case prepResultMaybe of
211+ Nothing -> error
212+ "traversePrepared_: LibPQ.prepare returned no results"
213+ Just _prepResult -> return () -- todo: check status of prepResult
191214 for_ list $ \ params -> do
192215 let
193216 toParam' bytes = (bytes,LibPQ.Binary)
194217 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
195− _result <- liftBase $
218+ resultMaybe <- liftBase $
196219 LibPQ.execPrepared conn temp params' LibPQ.Binary
197− return ()
198− _deallocResult <- liftBase $
220+ case resultMaybe of
221+ Nothing -> error
222+ "traversePrepared_: LibPQ.execParams returned no results"
223+ Just _result -> return ()
224+ deallocResultMaybe <- liftBase $
199225 LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
226+ case deallocResultMaybe of
227+ Nothing -> error
228+ "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
229+ Just _deallocResult -> return ()
230+ -- todo: check status of deallocResult
200231 return ((), Connection conn)
201232
202− connectPoll = PQ $ \ (Connection conn) -> do
203− pollingStatus <- liftBase $ LibPQ.connectPoll conn
204− return (pollingStatus, Connection conn)
233+ liftPQ pq = PQ $ \ (Connection conn) -> do
234+ y <- liftBase $ pq conn
235+ return (y, Connection conn)
205236
206237instance Monad m => Applicative (PQ schema schema m) where
207238 pure x = PQ $ \ conn -> pure (x, conn)
@@ -274,15 +305,73 @@ getValue
274305 (RowNumber r)
275306 (UnsafeColumnNumber c :: ColumnNumber n columns colty)
276307 (Result result)
277− = fromColumnValue @colty . K <$>
278− liftBase (LibPQ.getvalue result r c)
308+ = fmap (fromColumnValue @colty . K) $ liftBase $ do
309+ numRows <- LibPQ.ntuples result
310+ when (numRows < r) $ error $
311+ "getValue: expected at least " <> show r <> "rows but only saw "
312+ <> show numRows
313+ LibPQ.getvalue result r c
279314
280315getRow
281316 :: (FromRow columns y, MonadBase IO io)
282317 => RowNumber -> Result columns -> io y
283−getRow (RowNumber r) (Result result :: Result columns) = do
318+getRow (RowNumber r) (Result result :: Result columns) = liftBase $do
319+ numRows <- LibPQ.ntuples result
320+ when (numRows < r) $ error $
321+ "getRow: expected at least " <> show r <> "rows but only saw "
322+ <> show numRows
284323 let len = fromIntegral (lengthSList (Proxy @columns))
285− row' <- traverse (liftBase . LibPQ.getvalue result r) [0 .. len - 1]
324+ numCols <- LibPQ.nfields result
325+ when (numCols /= len) $ error $
326+ "getRow: expected at least " <> show len <> "columns but only saw "
327+ <> show numCols
328+ row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
286329 case fromList row' of
287330 Nothing -> error "getRow: found unexpected length"
288331 Just row -> return $ fromRow @columns row
332+
333+nextRow
334+ :: (FromRow columns y, MonadBase IO io)
335+ => Result columns -> RowNumber -> io (Maybe (RowNumber,y))
336+nextRow (Result result :: Result columns) (RowNumber r) = liftBase $ do
337+ numRows <- LibPQ.ntuples result -- todo: cache this
338+ if numRows < r then return Nothing else do
339+ let len = fromIntegral (lengthSList (Proxy @columns))
340+ numCols <- LibPQ.nfields result -- todo: cache this
341+ when (numCols /= len) $ error $
342+ "nextRow: expected at least " <> show len <> "columns but only saw "
343+ <> show numCols
344+ row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
345+ case fromList row' of
346+ Nothing -> error "nextRow: found unexpected length"
347+ Just row -> return $ Just (RowNumber (r+1), fromRow @columns row)
348+
349+getRows :: (FromRow columns y, MonadBase IO io) => Result columns -> io [y]
350+getRows (Result result :: Result columns) = liftBase $ do
351+ let len = fromIntegral (lengthSList (Proxy @columns))
352+ numCols <- LibPQ.nfields result
353+ when (numCols /= len) $ error $
354+ "getRow: expected at least " <> show len <> "columns but only saw "
355+ <> show numCols
356+ numRows <- LibPQ.ntuples result
357+ for [0 .. numRows - 1] $ \ r -> do
358+ row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
359+ case fromList row' of
360+ Nothing -> error "getRows: found unexpected length"
361+ Just row -> return $ fromRow @columns row
362+
363+getRowMaybe
364+ :: (FromRow columns y, MonadBase IO io)
365+ => RowNumber -> Result columns -> io (Maybe y)
366+getRowMaybe (RowNumber r) (Result result :: Result columns) = liftBase $do
367+ numRows <- LibPQ.ntuples result
368+ if numRows < r then return Nothing else do
369+ let len = fromIntegral (lengthSList (Proxy @columns))
370+ numCols <- LibPQ.nfields result
371+ when (numCols /= len) $ error $
372+ "getRow: expected at least " <> show len <> "columns but only saw "
373+ <> show numCols
374+ row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
375+ case fromList row' of
376+ Nothing -> error "getRow: found unexpected length"
377+ Just row -> return . Just $ fromRow @columns row