1 #lang racket 2 3 (provide crop 4 crop? 5 crop-id 6 crop-name 7 (contract-out [create-crop! (-> crop? crop?)] 8 [get-crops (-> (listof crop?))] 9 [get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))] 10 [update-crop! (-> crop? void?)] 11 [delete-crop! (-> db-id? void?)])) 12 13 (require db 14 sql 15 "../db/conn.rkt" 16 "utils.rkt") 17 18 (struct crop (id name) #:transparent) 19 20 ;; CREATE 21 22 (define (create-crop! c) 23 (define name (crop-name c)) 24 (or (get-crop #:name name) 25 (with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name])) 26 (get-crop #:name name)))) 27 28 ;; READ 29 30 (define (get-crops) 31 (for/list ([(id* name*) (in-query (current-conn) 32 (select id canonical_name #:from crops #:order-by id #:asc))]) 33 (crop id* name*))) 34 35 (define (get-crop #:id [id #f] #:name [name #f]) 36 (define where 37 (cond 38 [(and id name) (scalar-expr-qq (and (= id ,id) (= canonical_name ,name)))] 39 [id (scalar-expr-qq (= id ,id))] 40 [name (scalar-expr-qq (= canonical_name ,name))])) 41 (define query 42 (select id 43 canonical_name 44 #:from crops 45 #:where (ScalarExpr:AST ,where) 46 #:order-by id 47 #:asc 48 #:limit 1)) 49 (match (query-maybe-row (current-conn) query) 50 [(vector id* name*) (crop id* name*)] 51 [#f #f])) 52 53 ;; UPDATE 54 55 (define (update-crop! c) 56 (define id (or (crop-id c) (raise-argument-error 'update-crop! "db-id?" (crop-id c)))) 57 (with-tx (query-exec (current-conn) 58 (update crops #:set [canonical_name ,(crop-name c)] #:where [= id ,id])))) 59 60 ;; DELETE 61 62 (define (delete-crop! id) 63 (query-exec (current-conn) (delete #:from crops #:where (= id ,id)))) 64 65 (module+ test 66 (require rackunit 67 rackunit/text-ui 68 "../db/conn.rkt" 69 "../db/migrations.rkt") 70 71 (define test-crop-name "examplium-plant") 72 73 (run-tests (test-suite "Crop model" 74 #:before (λ () 75 (connect! #:path 'memory) 76 (migrate-all!)) 77 #:after (λ () (disconnect!)) 78 79 (test-case "Create crop" 80 (check-equal? (length (get-crops)) 0) 81 (define c1 (create-crop! (crop #f test-crop-name))) 82 (check-equal? (length (get-crops)) 1) 83 (check-true (crop? c1)) 84 (check-equal? (crop-name c1) test-crop-name) 85 (check-true (db-id? (crop-id c1)))) 86 87 (test-case "Create duplicate crop returns existing" 88 (define c1 (create-crop! (crop #f test-crop-name))) 89 (define c2 (create-crop! (crop #f test-crop-name))) 90 (check-equal? (length (get-crops)) 1) 91 (check-equal? (crop-id c1) (crop-id c2)) 92 (check-equal? c1 c2)) 93 94 (test-case "Get crop by id" 95 (define c1 (get-crop #:name test-crop-name)) 96 (define c2 (get-crop #:id (crop-id c1))) 97 (check-equal? c1 c2)) 98 99 (test-case "Get crop by name" 100 (define c (get-crop #:name test-crop-name)) 101 (check-true (crop? c)) 102 (check-equal? (crop-name c) test-crop-name)) 103 104 (test-case "Get crop with both id and name" 105 (define c1 (get-crop #:name test-crop-name)) 106 (define c2 (get-crop #:id (crop-id c1) #:name test-crop-name)) 107 (check-equal? c1 c2)) 108 109 (test-case "Get non-existent crop" 110 (check-false (get-crop #:name "non-existent-crop")) 111 (check-false (get-crop #:id 9999))) 112 113 (test-case "Get all crops" 114 (create-crop! (crop #f "ignorium-plant")) 115 (create-crop! (crop #f "testium-plant")) 116 (define crops (get-crops)) 117 (check-equal? (length crops) 3) 118 (check-true (andmap crop? crops))) 119 120 (test-case "Update crop name" 121 (define c1 (get-crop #:name test-crop-name)) 122 (define updated-crop (crop (crop-id c1) "examplium-updated")) 123 (update-crop! updated-crop) 124 (define c2 (get-crop #:id (crop-id c1))) 125 (check-equal? (crop-name c2) "examplium-updated") 126 (check-equal? (crop-id c1) (crop-id c2)) 127 (check-equal? (length (get-crops)) 3)) 128 129 (test-case "Update crop with invalid id raises error" 130 (define invalid-crop (crop #f "invalid")) 131 (check-exn exn:fail:contract? (λ () (update-crop! invalid-crop)))) 132 133 (test-case "Delete crop" 134 (define c (get-crop #:name "ignorium-plant")) 135 (delete-crop! (crop-id c)) 136 (check-false (get-crop #:id (crop-id c))) 137 (check-equal? (length (get-crops)) 2)) 138 139 (test-case "Delete crop by id" 140 (define c (get-crop #:name "testium-plant")) 141 (define crop-id-val (crop-id c)) 142 (delete-crop! crop-id-val) 143 (check-false (get-crop #:id crop-id-val)) 144 (check-equal? (length (get-crops)) 1))))) 145