query: add select-for-update

Author: Bogdanp

deta-doc/deta.scrbl

@@ -980,6 +980,12 @@ queries.
   schema.
 }
 
+@defproc[(select-for-update [q query?]) query?]{
+  Modifies @racket[q] to lock its rows against concurrent updates.
+
+  @history[#:added "0.20"]
+}
+
 @defform[
   (union query-1 query-2)
 ]{

deta-lib/info.rkt

@@ -1,7 +1,7 @@
 #lang info
 
 (define license 'BSD-3-Clause)
-(define version "0.19")
+(define version "0.20")
 (define collection "deta")
 
 (define deps '("base"

deta-lib/private/ast.rkt

@@ -100,7 +100,8 @@
  (struct-out union)
  (struct-out order-by)
  (struct-out returning)
- (struct-out where))
+ (struct-out where)
+ (struct-out select-for))
 
 (struct clause ()
   #:transparent)
@@ -139,6 +140,9 @@
 (struct where clause (e)
   #:transparent)
 
+(struct select-for clause (what)
+  #:transparent)
+
 
 ;; statements ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -186,7 +190,7 @@
                      #:returning [returning #f])
   (update table assignments where returning))
 
-(struct select stmt (distinct? columns from where group-by union order-by offset limit)
+(struct select stmt (distinct? columns from where group-by union order-by limit offset for-spec)
   #:transparent)
 
 (define (make-select #:distinct? [distinct? #f]
@@ -196,6 +200,7 @@
                      #:group-by [group-by #f]
                      #:union [union #f]
                      #:order-by [order-by #f]
+                     #:limit [limit #f]
                      #:offset [offset #f]
-                     #:limit [limit #f])
-  (select distinct? columns from where group-by union order-by offset limit))
+                     #:for [for-spec #f])
+  (select distinct? columns from where group-by union order-by limit offset for-spec))

deta-lib/private/dialect/standard.rkt

@@ -237,7 +237,7 @@
     [(list exprs ...)
      (write/sep exprs write-expr)]
 
-    [(select distinct? columns from where group-by union order-by offset limit)
+    [(select distinct? columns from where group-by union order-by limit offset for-spec)
      (write-string "SELECT ")
      (when distinct?
        (write-string "DISTINCT ")
@@ -255,7 +255,11 @@
      (when union    (display/space union))
      (when order-by (display/space order-by))
      (when limit    (display/space limit))
-     (when offset   (display/space offset))]
+     (when offset   (display/space offset))
+     (when for-spec (display/space for-spec))]
+
+    [(select-for 'update)
+     (write-string "FOR UPDATE")]
 
     [(update table assignments where returning)
      (write-string "UPDATE ")

deta-lib/private/query.rkt

@@ -109,6 +109,8 @@
        string?
        (hash/c symbol? ast:expr?)
        query?)]
+  [select-for-update
+   (-> query? query?)]
   [subquery (-> select-query? ast:subquery?)]
   [union (-> select-query? select-query? query?)]
   [update (-> select-query? assignment/c assignment/c ... query?)]
@@ -191,6 +193,18 @@
                                            (ast:qualified tbl-alias (field-name fld)))))))
   (project-onto q* s))
 
+(define (select-for-update q)
+  (match q
+    [(query schema opts (? ast:select? stmt))
+     (query schema opts (struct-copy
+                         ast:select stmt
+                         [for-spec (ast:select-for 'update)]))]
+
+    [_
+     (raise-argument-error
+      'select-for-update
+      "a SELECT query" q)]))
+
 (define (limit q n)
   (match q
     [(query schema opts stmt)

deta-lib/query.rkt

@@ -233,14 +233,18 @@
 
 (provide
  (contract-out
-  [in-entities (->* [connection? dyn:query?]
-                    [#:batch-size (or/c exact-positive-integer? +inf.0)]
-                    sequence?)]
-  [query-entities (->* [connection? dyn:query?]
-                       [#:batch-size (or/c exact-positive-integer? +inf.0)]
-                       (listof entity?))]
-  [lookup (-> connection? dyn:query? any)]
-  [refresh (-> connection? entity? (or/c #f entity?))])
+  [in-entities
+   (->* [connection? dyn:query?]
+        [#:batch-size (or/c exact-positive-integer? +inf.0)]
+        sequence?)]
+  [query-entities
+   (->* [connection? dyn:query?]
+        [#:batch-size (or/c exact-positive-integer? +inf.0)]
+        (listof entity?))]
+  [lookup
+   (-> connection? dyn:query? any)]
+  [refresh
+   (-> connection? entity? (or/c #f entity?))])
 
  from
  group-by
@@ -260,7 +264,8 @@
   [dyn:delete delete]
   [dyn:union union]
   [dyn:project-onto project-onto]
-  [dyn:project-virtual-fields project-virtual-fields])
+  [dyn:project-virtual-fields project-virtual-fields]
+  [dyn:select-for-update select-for-update])
 
  (contract-out
   [make-entity

deta-test/deta/sql-postgresql.rkt

@@ -276,6 +276,14 @@
 
        "SELECT CASE WHEN (MIN(d.employees)) > 0 THEN AVG(d.expenses / d.employees) ELSE 0 END FROM departments AS d"))
 
+    (test-case "FOR UPDATE"
+      (check-emitted
+       (select-for-update
+        (where
+         (from "workspaces" #:as w)
+         (= w.id 1)))
+       "SELECT * FROM workspaces AS w WHERE w.id = 1 FOR UPDATE"))
+
     (test-suite
      "from"