#lang racket

(provide nutrient-measurement
         nutrient-measurement?
         nutrient-measurement-id
         (rename-out [nutrient-measurement-measured-on nutrient-measurement-date]
                     [nutrient-measurement-nutrient-values nutrient-measurement-values])
         (contract-out
          [create-nutrient-measurement!
           (-> string? (listof nutrient-value-pair/c) nutrient-measurement?)]
          [get-nutrient-measurements (-> (listof nutrient-measurement?))]
          [get-nutrient-measurement
           (->* ()
                (#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?))
                (or/c nutrient-measurement? #f))]
          [get-nutrient-measurement-values (-> nutrient-measurement? (listof nutrient-value-pair/c))]
          [get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)]
          [get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))]
          [get-latest-nutrient-measurement-hash (-> (hash/c nutrient? number?))]
          [delete-nutrient-measurement! (-> nutrient-measurement? void?)]))

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

(struct nutrient-measurement (id measured-on nutrient-values)
  #:transparent
  #:property prop:custom-write
  (λ (v out _)
    (fprintf out
             "Measurement #~a on ~a\n"
             (nutrient-measurement-id v)
             (nutrient-measurement-measured-on v))
    (for ([nv (nutrient-measurement-nutrient-values v)])
      (match-define (cons n v) nv)
      (fprintf out
               "~a ~a\n"
               (~a (nutrient-name n) #:min-width 14)
               (~a v #:max-width 6 #:align 'right)))))

;; CREATE

(define (create-nutrient-measurement! measured-on nutrient-values)
  (or
   (get-nutrient-measurement #:measured-on measured-on)
   (with-tx
    (query-exec (current-conn) (insert #:into nutrient_measurements #:set [measured_on ,measured-on]))
    (define nm-id
      (query-value (current-conn)
                   (select id #:from nutrient_measurements #:where (= measured_on ,measured-on))))
    (query-exec (current-conn)
                (insert #:into nutrient_value_sets #:set [nutrient_measurement_id ,nm-id]))
    (define nvs-id
      (query-value (current-conn)
                   (select id #:from nutrient_value_sets #:where (= nutrient_measurement_id ,nm-id))))
    (for ([nv nutrient-values])
      (match-define (cons n v) nv)
      (query-exec (current-conn)
                  (insert #:into nutrient_values
                          #:set [value_set_id ,nvs-id]
                          [nutrient_id ,(nutrient-id n)]
                          [value_ppm ,v])))
    (get-nutrient-measurement #:measured-on measured-on))))

;; READ

(define joined
  (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm)
                                                     (as nutrient_value_sets nvs)
                                                     #:on (= nvs.nutrient_measurement_id nm.id))
                                         (as nutrient_values nv)
                                         #:on (= nv.value_set_id nvs.id))
                             (as nutrients n)
                             #:on (= n.id nv.nutrient_id))))

(define (grouped-row->nutrient-measurement row)
  (match-define (vector nm-id measured-on residuals) row)
  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
  (nutrient-measurement nm-id measured-on nutrient-value-pairs))

(define (get-nutrient-measurements)
  (define grouped-rows (query-rows (current-conn)
                                   (select nm.id
                                           nm.measured_on
                                           n.id
                                           n.canonical_name
                                           n.formula
                                           nv.value_ppm
                                           #:from (TableExpr:AST ,joined)
                                           #:order-by nm.measured_on
                                           #:desc)
                                   #:group '#(0 1)))
  (for/list ([row grouped-rows])
    (grouped-row->nutrient-measurement row)))

(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f])
  (define where
    (cond
      [(and nm-id measured-on)
       (scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))]
      [nm-id (scalar-expr-qq (= nm.id ,nm-id))]
      [measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))]
      [else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")]))
  (define grouped-rows
    (query-rows (current-conn)
                (select nm.id
                        nm.measured_on
                        n.id
                        n.canonical_name
                        n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:where (ScalarExpr:AST ,where)
                        #:order-by nm.measured_on
                        #:desc)
                #:group '#(0 1)))
  (match grouped-rows
    ['() #f]
    [(list row) (grouped-row->nutrient-measurement row)]
    [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))

(define (get-nutrient-measurement-values nutrient-measurement)
  (for/list ([(nutrient-id name formula value_ppm)
              (in-query (current-conn)
                        (select n.id
                                n.canonical_name
                                n.formula
                                nv.value_ppm
                                #:from (TableExpr:AST ,joined)
                                #:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
    (cons (nutrient nutrient-id name formula) value_ppm)))

(define (get-nutrient-measurement-value nutrient-measurement nutrient)
  (query-maybe-value (current-conn)
                     (select value_ppm
                             #:from (TableExpr:AST ,joined)
                             #:where (and (= nm.id ,(nutrient-measurement-id nutrient-measurement))
                                          (= nv.nutrient_id ,(nutrient-id nutrient))))))

(define (get-latest-nutrient-measurement-value nutrient)
  (query-maybe-value (current-conn)
                     (select value_ppm
                             #:from (TableExpr:AST ,joined)
                             #:where (= nv.nutrient_id ,(nutrient-id nutrient))
                             #:order-by nm.measured_on
                             #:desc
                             #:limit 1)))

(define (get-latest-nutrient-measurement-hash)
  (for/hash ([(n-id n-name n-formula residual-rows)
              (in-query (current-conn)
                        (select n.id
                                n.canonical_name
                                n.formula
                                nm.measured_on
                                nv.value_ppm
                                #:from (TableExpr:AST ,joined)
                                #:order-by nm.measured_on
                                #:desc)
                        #:group '(#(0 1 2)))])
    ;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm)
    (match-define (vector _measured-on value-ppm) (first residual-rows))
    (values (nutrient n-id n-name n-formula) value-ppm)))

;; UPDATE

;; DELETE

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