#lang racket

(provide
 ;; Struct definitions
 nutrient-measurement
 nutrient-measurement?
 nutrient-measurement-id
 (rename-out
  [nutrient-measurement-measured-on nutrient-measurement-date]
  [nutrient-measurement-nutrient-values nutrient-measurement-values])
 ;; SQL CRUD
 (contract-out
  [create-nutrient-measurement! (-> string?
                                    (listof (cons/c nutrient? number?))
                                    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 (cons/c nutrient? number?)))]
  [get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)]
  [get-latest-nutrient-measurement-value (-> nutrient? number?)]
  [delete-nutrient-measurement! (-> nutrient-measurement? void?)]))

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

;; Instances of this struct are persisted in the nutrient_measurements table.
(struct nutrient-measurement (id measured-on nutrient-values) #:transparent)


;; CREATE

(define (create-nutrient-measurement! measured-on nutrient-values)
  (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 nv
        [(cons n v)
         (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

(struct acc (measured-on pairs) #:transparent)

(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 (get-nutrient-measurements)
  (define query (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))
  (define rows (query-rows (current-conn) query))
  (define by-id
    (for/fold ([h (hash)]) ([row (in-list rows)])
      (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
      (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
      (hash-update h nm-id
                   (λ (old-acc)
                     (acc (acc-measured-on old-acc)
                          (cons nv-pair (acc-pairs old-acc))))
                   (λ ()
                     (acc measured-on
                          (list nv-pair))))))
  (for/list ([(id a) (in-hash by-id)])
    (nutrient-measurement id
                          (acc-measured-on a)
                          (reverse (acc-pairs a)))))

(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))]))
  (define query (select nm.id nm.measured_on
                        n.id n.canonical_name n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:where (ScalarExpr:AST ,where)))
  (define rows (query-rows (current-conn) query))
  (cond
    [(null? rows) #f]
    [else
     ;; Fold all nutrient rows belonging to the single measurement into one struct
     (define the-id #f)
     (define A #f)
     (for ([row (in-list rows)])
       (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
       (unless the-id (set! the-id nm-id))
       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
       (set! A (if A
                   (acc (acc-measured-on A)
                        (cons nv-pair (acc-pairs A)))
                   (acc measured-on (list nv-pair)))))
     (and A
          (nutrient-measurement the-id
                                (acc-measured-on A)
                                (reverse (acc-pairs A))))]))

(define (get-nutrient-measurement-values nutrient-measurement)
  (for/list ([(nutrient-id name formula value_ppm)
              (in-query (current-conn)
                        (string-join
                         '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
                           "FROM nutrient_values nv"
                           "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
                           "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
                           "JOIN nutrients n ON n.id = nv.nutrient_id"
                           "WHERE nm.id = $1"))
                        (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)
                     (string-join
                      '("SELECT value_ppm"
                        "FROM nutrient_values nv"
                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
                        "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
                        "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
                     (nutrient-measurement-id nutrient-measurement)
                     (nutrient-id nutrient)))

(define (get-latest-nutrient-measurement-value nutrient)
  (query-maybe-value (current-conn)
                     (string-join
                      '("SELECT value_ppm"
                        "FROM nutrient_values nv"
                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
                        "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
                        "WHERE nv.nutrient_id = $1"
                        "ORDER BY nm.measured_on DESC"
                        "LIMIT 1"))
                     (nutrient-id nutrient)))


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