Add support for DELETE verb

Fixes #125

src/App.hs

@@ -153,6 +153,18 @@ app reqBody req =
           $ update qt (map cs $ keys obj) (elems obj)
         return $ responseLBS status204 [ jsonH ] ""
 
+    ([table], "DELETE") -> do
+      let qt = QualifiedTable schema (cs table)
+      let del = coerce $ countT
+            . returningStarT
+            . whereT qq
+            $ deleteFrom qt
+      row <- H.single del
+      let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
+      return $ if deletedCount == 0
+         then responseLBS status404 [] ""
+         else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
+
     (_, _) ->
       return $ responseLBS status404 [] ""
 

src/PgQuery.hs

@@ -74,6 +74,12 @@ iffNotT (aq, ap, apre) (bq, bp, bpre) =
   , All $ getAll apre && getAll bpre
   )
 
+countT :: StatementT
+countT (sql, params, pre) =
+  ("WITH qqq AS (" <> sql <> ") SELECT count(1) FROM qqq"
+  , params
+  , pre)
+
 countRows :: QualifiedTable -> DynamicSQL
 countRows t =
   ("select count(1) from " <> fromQt t, [], mempty)
@@ -93,6 +99,14 @@ selectStar :: QualifiedTable -> DynamicSQL
 selectStar t =
   ("select * from " <> fromQt t, [], mempty)
 
+returningStarT :: StatementT
+returningStarT (sql, params, pre) =
+  (sql <> " RETURNING *", params, pre)
+
+deleteFrom :: QualifiedTable -> DynamicSQL
+deleteFrom t =
+  ("delete from " <> fromQt t, [], mempty)
+
 insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL
 insertInto t [] _ =
   ("insert into " <> fromQt t <> " default values returning *", [], mempty)