#lang racket

(provide
 ;; Struct definitions
 nutrient-target
 nutrient-target?
 nutrient-target-id
 (rename-out
  [nutrient-target-effective-on nutrient-target-date]
  [nutrient-target-nutrient-values nutrient-target-values])
 ;; SQL CRUD
 (contract-out
  [create-nutrient-target! (-> string?
                               (listof (cons/c nutrient? number?))
                               nutrient-target?)]
  [get-nutrient-targets (-> (listof nutrient-target?))]
  [get-nutrient-target (->* ()
                            (#:id           (or/c #f exact-nonnegative-integer?)
                             #:effective-on (or/c #f string?))
                            (or/c nutrient-target? #f))]
  [get-nutrient-target-values (-> nutrient-target? (listof (cons/c nutrient? number?)))]
  [get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
  [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
  [delete-nutrient-target! (-> nutrient-target? void?)]))

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

;; Instances of this struct are persisted in the nutrient_targets table.
(struct nutrient-target (id effective-on nutrient-values)
  #:transparent
  #:property prop:custom-write
  (λ (v out _)
    (fprintf out "Target #~a on ~a\n"
             (nutrient-target-id v)
             (nutrient-target-effective-on v))
    (for ([nv (nutrient-target-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-target! effective-on nutrient-values)
  (or (get-nutrient-target #:effective-on effective-on)
      (with-tx
        (query-exec (current-conn)
                    (insert #:into nutrient_targets
                            #:set [effective_on ,effective-on]))
        (define nt-id (query-value (current-conn)
                                   (select id
                                           #:from nutrient_targets
                                           #:where (= effective_on ,effective-on))))
        (query-exec (current-conn)
                    (insert #:into nutrient_value_sets
                            #:set [nutrient_target_id ,nt-id]))
        (define nvs-id (query-value (current-conn)
                                    (select id
                                            #:from nutrient_value_sets
                                            #:where (= nutrient_target_id ,nt-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-target #:effective-on effective-on))))


;; READ

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

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

(define (get-nutrient-targets)
  (define query (select nt.id nt.effective_on
                        n.id n.canonical_name n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:order-by nt.effective_on #:desc))
  (define rows (query-rows (current-conn) query))
  (define by-id
    (for/fold ([h (hash)]) ([row (in-list rows)])
      (match-define (vector nt-id effective-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 nt-id
                   (λ (old-acc)
                     (acc (acc-effective-on old-acc)
                          (cons nv-pair (acc-pairs old-acc))))
                   (λ ()
                     (acc effective-on
                          (list nv-pair))))))
  (for/list ([(id a) (in-hash by-id)])
    (nutrient-target id
                     (acc-effective-on a)
                     (reverse (acc-pairs a)))))

(define (get-nutrient-target #:id [nt-id #f]
                             #:effective-on [effective-on #f])
  (define where
    (cond
      [(and nt-id effective-on)
       (scalar-expr-qq (and (= nt.id ,nt-id)
                            (= nt.effective_on ,effective-on)))]
      [nt-id
       (scalar-expr-qq (= nt.id ,nt-id))]
      [effective-on
       (scalar-expr-qq (= nt.effective_on ,effective-on))]))
  (define query (select nt.id nt.effective_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 target into one struct
     (define the-id #f)
     (define A #f)
     (for ([row (in-list rows)])
       (match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
       (unless the-id (set! the-id nt-id))
       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
       (set! A (if A
                   (acc (acc-effective-on A)
                        (cons nv-pair (acc-pairs A)))
                   (acc effective-on (list nv-pair)))))
     (and A
          (nutrient-target the-id
                           (acc-effective-on A)
                           (reverse (acc-pairs A))))]))

(define (get-nutrient-target-values nutrient-target)
  (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-target-id nutrient-target))))])
    (cons (nutrient nutrient-id name formula) value_ppm)))

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

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


;; UPDATE


;; DELETE

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