From 14c8601fabdce6771c4d87ea811f7b25236a0e1b Mon Sep 17 00:00:00 2001
From: Nikita Volkov <nikita.y.volkov@mail.ru>
Date: Sun, 28 Dec 2014 04:03:17 +0300
Subject: [PATCH] Add 'singleTx', update docs, rename UnparsableResult to
 ResultError

---
 CHANGELOG.md           |  1 +
 hspec-postgres/Main.hs |  2 +-
 library/Hasql.hs       | 32 +++++++++++++++++++++++---------
 3 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ccc5ffc..30161e8 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,7 @@
 * The error types are now mostly backend-specific.
 * The transaction mode is now extended to support uncommittable transactions with the `TxWriteMode` type.
 * All `Tx` functions are now appended with a "Tx" suffix.
+* Added `vectorTx` and `maybeTx` and updated the semantics of `singleTx`.
 * `q` statement quasi-quoter is now renamed to more meaningful `stmt`.
 * The `Statement` type is renamed to `Stmt` and is now exported from the main API.
 * `RowParser` is now uninstantiable. This enforces the idiomatic usage of the library.
diff --git a/hspec-postgres/Main.hs b/hspec-postgres/Main.hs
index 03e62e7..c172e4e 100644
--- a/hspec-postgres/Main.hs
+++ b/hspec-postgres/Main.hs
@@ -89,7 +89,7 @@ main =
     context "RowParser" $ do
 
       it "should fail on incorrect arity" $ do
-        flip shouldSatisfy (\case Left (H.UnparsableResult _) -> True; _ -> False) =<< do
+        flip shouldSatisfy (\case Left (H.ResultError _) -> True; _ -> False) =<< do
           session $ do
             H.tx Nothing $ do
               H.unitTx [H.stmt|DROP TABLE IF EXISTS data|]
diff --git a/library/Hasql.hs b/library/Hasql.hs
index e4e1b28..fc3d253 100644
--- a/library/Hasql.hs
+++ b/library/Hasql.hs
@@ -33,6 +33,7 @@ module Hasql
   -- ** Statement Execution
   unitTx,
   countTx,
+  singleTx,
   maybeTx,
   listTx,
   vectorTx,
@@ -215,7 +216,7 @@ data SessionError c =
   -- |
   -- Attempt to parse a result into an incompatible type.
   -- Indicates either a mismatching schema or an incorrect query.
-  UnparsableResult Text
+  ResultError Text
 
 deriving instance (Show (Bknd.CxError c), Show (Bknd.TxError c)) => Show (SessionError c)
 deriving instance (Eq (Bknd.CxError c), Eq (Bknd.TxError c)) => Eq (SessionError c)
@@ -257,29 +258,42 @@ countTx =
 
 -- |
 -- Execute a statement,
--- which produces a single result row.
--- E.g., 
--- a @SELECT@ 
--- or an @INSERT@, which produces a generated value (e.g., an auto-incremented id).
+-- which produces exactly one result row.
+-- E.g., @INSERT@, which returns an autoincremented identifier,
+-- or @SELECT COUNT@, or @SELECT EXISTS@.
+-- 
+-- Please note that using this executor for selecting rows is conceptually wrong, 
+-- since in that case the results are always optional. 
+-- Use 'maybeTx', 'listTx' or 'vectorTx' instead.
+-- 
+-- If the result is empty this executor will raise 'ResultError'.
+singleTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s r
+singleTx =
+  join . fmap (maybe (Tx $ left $ ResultError "No rows on 'singleTx'") return) .
+  maybeTx
+
+-- |
+-- Execute a statement,
+-- which optionally produces a single result row.
 maybeTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s (Maybe r)
 maybeTx =
   fmap (fmap Vector.unsafeHead . mfilter (not . Vector.null) . Just) . vectorTx
 
 -- |
--- Execute a @SELECT@ statement,
+-- Execute a statement,
 -- and produce a list of results.
 listTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s [r]
 listTx =
   fmap toList . vectorTx
 
 -- |
--- Execute a @SELECT@ statement,
+-- Execute a statement,
 -- and produce a vector of results.
 vectorTx :: RowParser.RowParser c r => Bknd.Stmt c -> Tx c s (Vector r)
 vectorTx s =
   Tx $ do
     r <- lift $ Bknd.vectorTx s
-    EitherT $ return $ traverse ((mapLeft UnparsableResult) . RowParser.parseRow) $ r
+    EitherT $ return $ traverse ((mapLeft ResultError) . RowParser.parseRow) $ r
 
 -- |
 -- Execute a @SELECT@ statement with a cursor,
@@ -296,7 +310,7 @@ streamTx s =
     r <- lift $ Bknd.streamTx s
     return $ TxListT $ do
       row <- hoist (Tx . lift) r
-      lift $ Tx $ EitherT $ return $ mapLeft UnparsableResult $ RowParser.parseRow $ row
+      lift $ Tx $ EitherT $ return $ mapLeft ResultError $ RowParser.parseRow $ row
 
 
 -- * Result Stream