From 3008eb25f79ef1ed54fcc2b3f5b6635b34394680 Mon Sep 17 00:00:00 2001
From: Marius Peter <dev@marius-peter.com>
Date: Sun, 19 Oct 2025 21:15:18 +0200
Subject: Absorb existing domain data.

---
 models/crop.rkt | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)
 create mode 100644 models/crop.rkt

(limited to 'models/crop.rkt')

diff --git a/models/crop.rkt b/models/crop.rkt
new file mode 100644
index 0000000..7163cbd
--- /dev/null
+++ b/models/crop.rkt
@@ -0,0 +1,103 @@
+#lang racket
+
+(provide
+ ;; Struct definitions
+ crop
+ crop?
+ crop-id crop-name
+ ;; SQL CRUD
+ (contract-out
+  [create-crop! (-> string? void?)]
+  [get-crops (->* ()
+                  (#:id      (or/c #f exact-nonnegative-integer?)
+                   #:name    (or/c #f string?))
+                  (listof crop?))]
+  [get-crop (->* ()
+                 (#:id      (or/c #f exact-nonnegative-integer?)
+                  #:name    (or/c #f string?))
+                 (or/c crop? #f))]
+  [update-crop! (->* (exact-nonnegative-integer?)
+                     (#:name    (or/c #f string?))
+                     (or/c crop? #f))]
+  [delete-crop! (-> exact-nonnegative-integer? void?)]))
+
+(require racket/contract
+         db
+         sql
+         "../db/conn.rkt")
+
+(struct crop (id name) #:transparent)
+
+
+;; CREATE
+
+(define (create-crop! name)
+  (query-exec (current-conn)
+              (insert #:into crops
+                      #:set [canonical_name ,name])))
+
+
+;; READ
+
+(define (get-crops #:id [id #f]
+                   #:name [name #f])
+  (define (where-expr)
+    (define clauses
+      (filter values
+              (list
+               (and id (format "id = ~e" id))
+               (and name (format "canonical_name = ~e" name)))))
+    (cond
+      [(null? clauses) ""]
+      [else (format "WHERE ~a" (string-join clauses " AND "))]))
+  (define query (string-join
+                 `("SELECT id, canonical_name"
+                   "FROM crops"
+                   ,(where-expr)
+                   "ORDER BY id ASC")))
+  (for/list ([(id* name*)
+              (in-query (current-conn) query)])
+    (crop id* name*)))
+
+(define (get-crop #:id [id #f]
+                  #:name [name #f])
+  (define (where-expr)
+    (define clauses
+      (filter values
+              (list (and id (format "id = ~e" id))
+                    (and name (format "canonical_name = ~e" name)))))
+    (cond
+      [(null? clauses) ""]
+      [else (format "WHERE ~a" (string-join clauses " AND "))]))
+  (define query (string-join
+                 `("SELECT id, canonical_name"
+                   "FROM crops"
+                   ,(where-expr)
+                   "ORDER BY id ASC"
+                   "LIMIT 1")))
+  (match (query-maybe-row (current-conn) query)
+    [(vector id* name*)
+     (crop id* name*)]
+    [#f #f]))
+
+
+;; UPDATE
+
+(define (update-crop! id
+                      #:name [name #f])
+  (cond
+    [name
+     (query-exec (current-conn)
+                 (update crops
+                         #:set [canonical_name ,name]
+                         #:where (= id ,id)))]
+    [else (void)])
+  (or (get-crop #:id id)
+      (error 'update-crop! "No crop with id ~a" id)))
+
+
+;; DELETE
+
+(define (delete-crop! id)
+  (query-exec (current-conn)
+              (delete #:from crops #:where (= id ,id))))
-- 
cgit v1.2.3