#lang racket

(provide nutrient
         nutrient?
         nutrient-id
         nutrient-canonical-name
         nutrient-french-name
         nutrient-formula
         nutrient-value-hash/c
         (contract-out [create-nutrient! (-> string? string? string? nutrient?)]
                       [get-nutrients (-> (listof nutrient?))]
                       [get-nutrient
                        (->* ()
                             (#:id (or/c #f exact-nonnegative-integer?)
                                   #:name (or/c #f string?)
                                   #:formula (or/c #f string?))
                             (or/c nutrient? #f))]
                       [update-nutrient!
                        (->* (nutrient?)
                             (#:name (or/c #f string?) #:formula (or/c #f string?))
                             (or/c nutrient? #f))]
                       [delete-nutrient! (-> nutrient? void?)]
                       [residuals->nutrient-value-hash
                        (-> (listof residual-vector/c) nutrient-value-hash/c)]))

(require racket/contract
         db
         sql
         "../db/conn.rkt")

(struct nutrient (id canonical-name french-name formula)
  #:transparent
  #:property prop:custom-write
  (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v))))

(define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t))

;; vector/c id, canonical name, french name, nutrient formula, value (ppm)
(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? string? real?))

(define (residuals->nutrient-value-hash residuals)
  (for/hash ([r (in-list residuals)])
    (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r)
    (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))

;; CREATE

(define (create-nutrient! canonical-name french-name formula)
  (or (get-nutrient #:name canonical-name #:formula formula)
      (with-tx
        (query-exec (current-conn)
                    (insert #:into nutrients
                            #:set [canonical_name ,canonical-name]
                            [french_name ,french-name]
                            [formula ,formula]))
        (get-nutrient #:name canonical-name))))

;; READ

(define (row->nutrient row)
  (match-define (vector id canonical-name french-name formula) row)
  (nutrient id canonical-name french-name formula))

(define (get-nutrients)
  (define rows
    (query-rows (current-conn)
                (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc)))
  (map row->nutrient rows))

(define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f])
  (define where
    (cond
      [(and id canonical-name formula)
       (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))]
      [id (scalar-expr-qq (= id ,id))]
      [(and canonical-name formula)
       (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))]
      [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))]
      [formula (scalar-expr-qq (= formula ,formula))]))
  (match (query-maybe-row (current-conn)
                          (select id
                                  canonical_name
                                  french_name
                                  formula
                                  #:from nutrients
                                  #:where (ScalarExpr:AST ,where)
                                  #:order-by id
                                  #:asc
                                  #:limit 1))
    [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)]
    [#f #f]))

;; UPDATE

(define (update-nutrient! nutrient #:name [name #f] #:formula [formula #f])
  (define id (nutrient-id nutrient))
  (cond
    [(and name formula)
     (query-exec
      (current-conn)
      (update nutrients #:set [canonical_name ,name] [formula ,formula] #:where (= id ,id)))]
    [name
     (query-exec (current-conn) (update nutrients #:set [canonical_name ,name] #:where (= id ,id)))]
    [formula
     (query-exec (current-conn) (update nutrients #:set [formula ,formula] #:where (= id ,id)))]
    [else (void)])
  (or (get-nutrient #:id id) (error 'update-nutrient! "No nutrient with id ~a" id)))

;; DELETE

(define (delete-nutrient! nutrient)
  (query-exec (current-conn) (delete #:from nutrients #:where (= id ,(nutrient-id nutrient)))))