Improve error when using RowDecoderMonadic that decodes less fields t…

hpgsql-tests/BasicTestsSpec.hs

@@ -133,6 +133,16 @@ queryMWithismatchInNumberOfColumns conn = do
   queryMWith (toMonadicRowDecoder $ rowDecoder @(Int, Int, Int, String)) conn "select 1, 2, 3"
     `shouldThrow` irrecoverableErrorWithMsgAndStmt "select 1, 2, 3" "More columns expected by the row parser than found in query results. Expected 4 but got 3"
 
+  -- When fetching more columns than expected
+  queryWith (rowDecoder @(Only Int)) conn "select 1, 2"
+    `shouldThrow` irrecoverableErrorWithMsg
+      "Query result contains 2 columns but row parser expected 1"
+  queryMWith
+    (toMonadicRowDecoder $ rowDecoder @(Only Int))
+    conn
+    "select 1, 2"
+    `shouldThrow` irrecoverableErrorWithMsg "Query result contains 2 columns but the row parser only consumed 1"
+
 queryMWithismatchInTypesOfColumns :: HPgConnection -> IO ()
 queryMWithismatchInTypesOfColumns conn = do
   queryWith (rowDecoder @(Bool, Bool)) conn "select 1, 2"

hpgsql/src/Hpgsql/Encoding/RowDecoderMonadic.hs

@@ -43,7 +43,8 @@ instance Monad RowDecoderMonadic where
   RowDecoderMonadic {fullRowDecoder} >>= f = RowDecoderMonadic $ \cs0 -> do
     (row, numColsParsed) <- fullRowDecoder cs0
     let RowDecoderMonadic {fullRowDecoder = parserOfRemainder} = f row
-    parserOfRemainder cs0 {colsLeftToParse = List.drop numColsParsed cs0.colsLeftToParse}
+    (finalRow, numColsParsedByRemainder) <- parserOfRemainder cs0 {colsLeftToParse = List.drop numColsParsed cs0.colsLeftToParse}
+    pure (finalRow, numColsParsed + numColsParsedByRemainder)
 
 -- | Takes an Applicative row parser (which type-checks result rows only once per query)
 -- and transforms it into a Monadic row parser, which is more flexible, but pays the

hpgsql/src/Hpgsql/Internal.hs

@@ -1414,7 +1414,14 @@ consumeStreamingResults rp conn qryId = S.effect $ do
           unless (numResultColumns == expectedNumCols) $ throwIrrecoverableErrorWithStatement qText $ "Query result contains " <> Text.pack (show numResultColumns) <> " columns but row parser expected " <> Text.pack (show expectedNumCols)
           unless (all snd typecheckedColInfos) $ throwIrrecoverableErrorWithStatement qText "Query result column types do not match expected column types"
           pure $ Parser.skip 7 *> rparser colInfos -- Skip msg ident., length, number of columns, then parse fields
-        MonadicRowDecoder (RowDecoderMonadic rparser) -> pure $ Parser.skip 7 *> fmap fst (rparser ConversionState {colsLeftToParse = colInfos})
+        MonadicRowDecoder (RowDecoderMonadic rparser) ->
+          pure $
+            Parser.skip 7 *> do
+              (row, numColsParsed) <- rparser ConversionState {colsLeftToParse = colInfos}
+              unless (numColsParsed == numResultColumns) $
+                fail $
+                  "Query result contains " ++ show numResultColumns ++ " columns but the row parser only consumed " ++ show numColsParsed
+              pure row
       pure $ do
         errOrCmdComplete <-
           S.concat $