Non-parametric query execution and refactorings

library/Hasql.hs

@@ -9,6 +9,7 @@ module Hasql
   ParametricQuery(..),
   NonparametricQuery(..),
   executeParametricQuery,
+  executeNonparametricQuery,
   -- * Errors
   AcquisitionError(..),
   ResultsError(..),
@@ -126,13 +127,21 @@ type NonparametricQuery a =
   (ByteString, Deserialization.Results a)
 
 -- |
--- Execute a query, producing either a deserialization failure or a successful result.
+-- Execute a parametric query, producing either a deserialization failure or a successful result.
 executeParametricQuery :: Connection -> ParametricQuery a b -> a -> IO (Either ResultsError b)
 executeParametricQuery (Connection pqConnection integerDatetimes registry) (template, serializer, deserializer, preparable) params =
   fmap (mapLeft coerceResultsError) $ runEitherT $ do
     EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceSerializer serializer) preparable params
     EitherT $ IO.getResults pqConnection integerDatetimes (coerceDeserializer deserializer)
 
+-- |
+-- Execute a non-parametric query, producing either a deserialization failure or a successful result.
+executeNonparametricQuery :: Connection -> NonparametricQuery a -> IO (Either ResultsError a)
+executeNonparametricQuery (Connection pqConnection integerDatetimes registry) (sql, deserializer) =
+  fmap (mapLeft coerceResultsError) $ runEitherT $ do
+    EitherT $ IO.sendNonparametricQuery pqConnection sql
+    EitherT $ IO.getResults pqConnection integerDatetimes (coerceDeserializer deserializer)
+
 -- |
 -- WARNING: We need to take special care that the structure of
 -- the "ResultsDeserialization.Error" type in the public API is an exact copy of

library/Hasql/Deserialization/Results.hs

@@ -71,6 +71,22 @@ getResultMaybe :: Results (Maybe LibPQ.Result)
 getResultMaybe =
   Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection
 
+{-# INLINABLE dropRemainders #-}
+dropRemainders :: Results ()
+dropRemainders =
+  Results $ ReaderT $ \(integerDatetimes, connection) -> loop integerDatetimes connection
+  where
+    loop integerDatetimes connection =
+      getResultMaybe >>= Prelude.maybe (pure ()) onResult
+      where
+        getResultMaybe =
+          lift $ LibPQ.getResult connection
+        onResult result =
+          checkErrors *> loop integerDatetimes connection
+          where
+            checkErrors =
+              EitherT $ fmap (mapLeft ResultError) $ Result.run Result.unit (integerDatetimes, result)
+
 cancel :: Results ()
 cancel =
   undefined

library/Hasql/IO.hs

@@ -61,10 +61,7 @@ initConnection c =
 {-# INLINE getResults #-}
 getResults :: LibPQ.Connection -> Bool -> ResultsDeserialization.Results a -> IO (Either ResultsDeserialization.Error a)
 getResults connection integerDatetimes des =
-  do
-    result <- ResultsDeserialization.run des (integerDatetimes, connection)
-    fix $ \loop -> LibPQ.getResult connection >>= maybe (pure ()) (const loop)
-    pure result
+  ResultsDeserialization.run (des <* ResultsDeserialization.dropRemainders) (integerDatetimes, connection)
 
 {-# INLINABLE getPreparedStatementKey #-}
 getPreparedStatementKey ::
@@ -145,3 +142,8 @@ sendParametricQuery connection integerDatetimes registry template serializer pre
           ParamsSerialization.run'' serializer params integerDatetimes
         in
           sendUnpreparedParametricQuery connection template paramList
+
+{-# INLINABLE sendNonparametricQuery #-}
+sendNonparametricQuery :: LibPQ.Connection -> ByteString -> IO (Either ResultsDeserialization.Error ())
+sendNonparametricQuery connection sql =
+  checkedSend connection $ LibPQ.sendQuery connection sql