#lang racket

(provide nutrient
         nutrient?
         nutrient-id
         nutrient-canonical-name
         nutrient-french-name
         nutrient-formula
         nutrient-value?
         maybe-nutrient-value?
         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? (and/c real? (>=/c 0)))
(define maybe-nutrient-value? (or/c nutrient-value? #f))
(define nutrient-value-hash/c (hash/c nutrient? nutrient-value? #: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)
  (map row->nutrient
       (query-rows
        (current-conn)
        (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc))))

(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)))))

(module+ test
  (require rackunit
           rackunit/text-ui
           "../db/conn.rkt"
           "../db/migrations.rkt")

  (run-tests (test-suite "Nutrient model"
               #:before (λ ()
                          (connect! #:path 'memory)
                          (migrate-all!))
               #:after (λ () (disconnect!))

               (test-case "Create nutrients"
                 (check-equal? (length (get-nutrients)) 0)
                 (create-nutrient! "Examplium" "" "Ex")
                 (check-equal? (length (get-nutrients)) 1)
                 (create-nutrient! "Ignorium" "" "Ig")
                 (check-equal? (length (get-nutrients)) 2))

               (test-case "Read nutrient"
                 (define examplium (get-nutrient #:id 1))
                 (check-true (nutrient? examplium))
                 (check-equal? (nutrient-id examplium) 1))

               (test-case "Read nutrient by name"
                 (define examplium (get-nutrient #:name "Examplium"))
                 (check-true (nutrient? examplium))
                 (check-equal? (nutrient-canonical-name examplium) "Examplium"))

               (test-case "Read nutrient by formula"
                 (define examplium (get-nutrient #:formula "Ex"))
                 (check-true (nutrient? examplium))
                 (check-equal? (nutrient-formula examplium) "Ex"))

               (test-case "Read inexisting nutrient"
                 (check-false (get-nutrient #:name "Inexistium")))

               (test-case "Update nutrient name"
                 (define examplium (get-nutrient #:name "Examplium"))
                 (define examplium-nitrate (update-nutrient! examplium #:name "Examplium Nitrate"))
                 (check-equal? (length (get-nutrients)) 2)
                 (check-equal? (nutrient-canonical-name examplium-nitrate) "Examplium Nitrate")
                 (check-equal? (nutrient-formula examplium-nitrate) "Ex"))

               (test-case "Update nutrient formula"
                 (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
                 (define examplium-sulfate (update-nutrient! examplium-nitrate #:formula "ExSO4"))
                 (check-equal? (length (get-nutrients)) 2)
                 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Nitrate")
                 (check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))

               (test-case "Update nutrient name and formula"
                 (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
                 (define examplium-sulfate
                   (update-nutrient! examplium-nitrate #:name "Examplium Sulfate" #:formula "ExNO3"))
                 (check-equal? (length (get-nutrients)) 2)
                 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Sulfate")
                 (check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))

               (test-case "Delete nutrient"
                 (define examplium-sulfate (get-nutrient #:name "Examplium Sulfate"))
                 (delete-nutrient! examplium-sulfate)
                 (check-equal? (length (get-nutrients)) 1)
                 (define ignorium (get-nutrient #:name "Ignorium"))
                 (delete-nutrient! ignorium)
                 (check-equal? (length (get-nutrients)) 0)))))