#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? (or/c number? #f))]
  [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
  #: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

(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 value rows belonging to the single nutrient 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)
                        (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)))


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