#lang racket

(provide nutrient-target
         nutrient-target?
         nutrient-target-id
         (rename-out [nutrient-target-effective-on nutrient-target-date]
                     [nutrient-target-nutrient-values nutrient-target-values])
         (contract-out [create-nutrient-target! (-> string? nutrient-value-hash/c 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? nutrient-value-hash/c)]
                       [get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
                       [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
                       [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))]
                       [delete-nutrient-target! (-> nutrient-target? void?)]))

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

(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 ([(n v) (in-hash (nutrient-target-nutrient-values v))])
      (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 ([(n v) (in-hash nutrient-values)])
         (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

(define joined
  (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt)
                                                     (as nutrient_value_sets nvs)
                                                     #:on (= nvs.nutrient_target_id nt.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-target row)
  (match-define (vector nt-id effective-on residuals) row)
  (nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals)))

(define (get-nutrient-targets)
  (for/list ([grouped-row (in-query (current-conn)
                                    (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)
                                    #:group '#(0 1))])
    (grouped-row->nutrient-target grouped-row)))

(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))]
      [else (error 'get-nutrient-target "either #:id or #:effective-on must be provided")]))
  (define grouped-rows
    (query-rows (current-conn)
                (select nt.id
                        nt.effective_on
                        n.id
                        n.canonical_name
                        n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:where (ScalarExpr:AST ,where)
                        #:order-by nt.effective_on
                        #:desc)
                #:group '#(0 1)))
  (match grouped-rows
    ['() #f]
    [(list row) (grouped-row->nutrient-target row)]
    [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))

(define (get-nutrient-target-values nutrient-target)
  (for/hash ([(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 (= nt.id ,(nutrient-target-id nutrient-target))))])
    (values (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 (= nt.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)))

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

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