1 #lang racket 2 3 (provide nutrient 4 nutrient? 5 nutrient-id 6 nutrient-canonical-name 7 nutrient-french-name 8 nutrient-formula 9 (contract-out [create-nutrient! (-> string? string? string? nutrient?)] 10 [get-nutrients (-> (listof nutrient?))] 11 [get-nutrient 12 (->* () (#:id db-id? #:name string? #:formula string?) (or/c nutrient? #f))] 13 [update-nutrient! 14 (->* (nutrient?) 15 (#:name (or/c #f string?) #:formula (or/c #f string?)) 16 (or/c nutrient? #f))] 17 [delete-nutrient! (-> nutrient? void?)])) 18 19 (require db 20 sql 21 "../db/conn.rkt" 22 "utils.rkt") 23 24 (struct nutrient (id canonical-name french-name formula) 25 #:transparent 26 #:property prop:custom-write 27 (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v)))) 28 29 ;; CREATE 30 31 (define (create-nutrient! canonical-name french-name formula) 32 (or (get-nutrient #:name canonical-name #:formula formula) 33 (with-tx (query-exec (current-conn) 34 (insert #:into nutrients 35 #:set [canonical_name ,canonical-name] 36 [french_name ,french-name] 37 [formula ,formula])) 38 (get-nutrient #:name canonical-name)))) 39 40 ;; READ 41 42 (define (row->nutrient row) 43 (match-define (vector id canonical-name french-name formula) row) 44 (nutrient id canonical-name french-name formula)) 45 46 (define (get-nutrients) 47 (map row->nutrient 48 (query-rows 49 (current-conn) 50 (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc)))) 51 52 (define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f]) 53 (define where 54 (cond 55 [(and id canonical-name formula) 56 (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))] 57 [id (scalar-expr-qq (= id ,id))] 58 [(and canonical-name formula) 59 (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))] 60 [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))] 61 [formula (scalar-expr-qq (= formula ,formula))])) 62 (match (query-maybe-row (current-conn) 63 (select id 64 canonical_name 65 french_name 66 formula 67 #:from nutrients 68 #:where (ScalarExpr:AST ,where) 69 #:order-by id 70 #:asc 71 #:limit 1)) 72 [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)] 73 [#f #f])) 74 75 ;; UPDATE 76 77 (define (update-nutrient! nutrient #:name [name #f] #:formula [formula #f]) 78 (define id (nutrient-id nutrient)) 79 (cond 80 [(and name formula) 81 (query-exec 82 (current-conn) 83 (update nutrients #:set [canonical_name ,name] [formula ,formula] #:where (= id ,id)))] 84 [name 85 (query-exec (current-conn) (update nutrients #:set [canonical_name ,name] #:where (= id ,id)))] 86 [formula 87 (query-exec (current-conn) (update nutrients #:set [formula ,formula] #:where (= id ,id)))] 88 [else (void)]) 89 (or (get-nutrient #:id id) (error 'update-nutrient! "No nutrient with id ~a" id))) 90 91 ;; DELETE 92 93 (define (delete-nutrient! nutrient) 94 (query-exec (current-conn) (delete #:from nutrients #:where (= id ,(nutrient-id nutrient))))) 95 96 (module+ test 97 (require rackunit 98 rackunit/text-ui 99 "../db/conn.rkt" 100 "../db/migrations.rkt") 101 102 (run-tests (test-suite "Nutrient model" 103 #:before (λ () 104 (connect! #:path 'memory) 105 (migrate-all!)) 106 #:after (λ () (disconnect!)) 107 108 (test-case "Create nutrients" 109 (check-equal? (length (get-nutrients)) 0) 110 (create-nutrient! "Examplium" "" "Ex") 111 (check-equal? (length (get-nutrients)) 1) 112 (create-nutrient! "Ignorium" "" "Ig") 113 (check-equal? (length (get-nutrients)) 2)) 114 115 (test-case "Read nutrient" 116 (define examplium (get-nutrient #:id 1)) 117 (check-true (nutrient? examplium)) 118 (check-equal? (nutrient-id examplium) 1)) 119 120 (test-case "Read nutrient by name" 121 (define examplium (get-nutrient #:name "Examplium")) 122 (check-true (nutrient? examplium)) 123 (check-equal? (nutrient-canonical-name examplium) "Examplium")) 124 125 (test-case "Read nutrient by formula" 126 (define examplium (get-nutrient #:formula "Ex")) 127 (check-true (nutrient? examplium)) 128 (check-equal? (nutrient-formula examplium) "Ex")) 129 130 (test-case "Read inexisting nutrient" 131 (check-false (get-nutrient #:name "Inexistium"))) 132 133 (test-case "Update nutrient name" 134 (define examplium (get-nutrient #:name "Examplium")) 135 (define examplium-nitrate (update-nutrient! examplium #:name "Examplium Nitrate")) 136 (check-equal? (length (get-nutrients)) 2) 137 (check-equal? (nutrient-canonical-name examplium-nitrate) "Examplium Nitrate") 138 (check-equal? (nutrient-formula examplium-nitrate) "Ex")) 139 140 (test-case "Update nutrient formula" 141 (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate")) 142 (define examplium-sulfate (update-nutrient! examplium-nitrate #:formula "ExSO4")) 143 (check-equal? (length (get-nutrients)) 2) 144 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Nitrate") 145 (check-equal? (nutrient-formula examplium-sulfate) "ExSO4")) 146 147 (test-case "Update nutrient name and formula" 148 (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate")) 149 (define examplium-sulfate 150 (update-nutrient! examplium-nitrate #:name "Examplium Sulfate" #:formula "ExNO3")) 151 (check-equal? (length (get-nutrients)) 2) 152 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Sulfate") 153 (check-equal? (nutrient-formula examplium-sulfate) "ExNO3")) 154 155 (test-case "Delete nutrient" 156 (define examplium-sulfate (get-nutrient #:name "Examplium Sulfate")) 157 (delete-nutrient! examplium-sulfate) 158 (check-equal? (length (get-nutrients)) 1) 159 (define ignorium (get-nutrient #:name "Ignorium")) 160 (delete-nutrient! ignorium) 161 (check-equal? (length (get-nutrients)) 0))))) 162