From 709e70561f8b527998b8ed8ac0916e92b1a5e17b Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Sat, 9 May 2015 12:21:14 -0700
Subject: [PATCH] Provide more information in PATCH response

* 404 if no records updated
* Range header for number updated
* Full results depending on Prefer header

Fixes #187
Fixes #182
---
 src/App.hs                 | 22 ++++++++++++++++++----
 src/PgQuery.hs             |  6 ++++++
 test/Feature/InsertSpec.hs | 19 ++++++++++++++++---
 3 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/src/App.hs b/src/App.hs
index bb5f52a5c..280cd6880 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -39,6 +39,8 @@ import PgQuery
 import RangeQuery
 import PgStructure
 
+import Debug.Trace
+
 app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app v1schema reqBody req =
   case (path, verb) of
@@ -164,10 +166,22 @@ app v1schema reqBody req =
     ([table], "PATCH") ->
       handleJsonObj reqBody $ \obj -> do
         let qt = QualifiedTable schema (cs table)
-        H.unitEx
-          $ whereT qq
-          $ update qt (map cs $ M.keys obj) (M.elems obj)
-        return $ responseLBS status204 [ jsonH ] ""
+            up = returningStarT
+               . whereT qq
+               $ update qt (map cs $ M.keys obj) (M.elems obj)
+            patch = withT up "t" $ B.Stmt
+              "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying"
+              V.empty True
+
+        row <- H.maybeEx $ traceShow (B.stmtTemplate patch) patch
+        let (queryTotal, body) =
+              fromMaybe (0 :: Int, Just "" :: Maybe Text) row
+            r = contentRangeH 0 (queryTotal-1) queryTotal
+            echoRequested = lookup "Prefer" hdrs == Just "return=representation"
+            s = case () of _ | queryTotal == 0 -> status404
+                             | echoRequested -> status200
+                             | otherwise -> status204
+        return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
 
     ([table], "DELETE") -> do
       let qt = QualifiedTable schema (cs table)
diff --git a/src/PgQuery.hs b/src/PgQuery.hs
index ec58c08a6..2fc3d5ad2 100644
--- a/src/PgQuery.hs
+++ b/src/PgQuery.hs
@@ -59,6 +59,12 @@ whereT params q =
    cols = [ col | col <- params, fst col `notElem` ["order"] ]
    conjunction = mconcat $ L.intersperse andq (map wherePred cols)
 
+withT :: PStmt -> T.Text -> StatementT
+withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
+  B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
+    (ep <> wp)
+    (epre && wpre)
+
 orderT :: [OrderTerm] -> StatementT
 orderT ts q =
   if L.null ts
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 3581a1869..02c917158 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -232,10 +232,10 @@ spec = afterAll_ resetDb $ around withApp $ do
             `shouldRespondWith` 404
 
     context "on an empty table" $
-      it "succeeds with no effect" $
+      it "indicates no records found to update" $
         request methodPatch "/simple_pk" []
           [json| { "extra":20 } |]
-            `shouldRespondWith` 204
+            `shouldRespondWith` 404
 
     context "in a nonempty table" . before_ (clearTable "items" >> createItems 15) .
       after_ (clearTable "items") $ do
@@ -245,7 +245,11 @@ spec = afterAll_ resetDb $ around withApp $ do
           `shouldSatisfy` matchHeader "Content-Range" "\\*/0"
         request methodPatch "/items?id=eq.1" []
           [json| { "id":42 } |]
-            `shouldRespondWith` 204
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing,
+              matchStatus  = 204,
+              matchHeaders = ["Content-Range" <:> "0-0/1"]
+            }
         g' <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g'
           `shouldSatisfy` matchHeader "Content-Range" "0-0/1"
@@ -261,3 +265,12 @@ spec = afterAll_ resetDb $ around withApp $ do
         g <- get "/auto_incrementing_pk?non_nullable_string=eq.c"
         liftIO $ simpleHeaders g
           `shouldSatisfy` matchHeader "Content-Range" "0-9/10"
+
+      it "can provide a representation" $ do
+        _ <- post "/items"
+          [json| { id: 1 } |]
+        request methodPatch
+          "/items?id=eq.1"
+          [("Prefer", "return=representation")]
+          [json| { id: 99 } |]
+          `shouldRespondWith` [json| [{id:99}] |]