#lang racket

(provide nutrient-target
         nutrient-target?
         nutrient-target-id
         (rename-out [nutrient-target-target-date 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 exact-nonnegative-integer? #:date string?) (or/c nutrient-target? #f))]
          [get-nutrient-target-values (-> nutrient-target-or-id/c nutrient-value-hash/c)]
          [get-nutrient-target-value (-> nutrient-target-or-id/c nutrient? maybe-nutrient-value?)]
          [get-latest-nutrient-target-value (-> nutrient? maybe-nutrient-value?)]
          [get-latest-nutrient-target-values (-> nutrient-value-hash/c)]
          [delete-nutrient-target! (-> nutrient-target-or-id/c void?)]))

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

(struct nutrient-target (id target-date nutrient-values)
  #:transparent
  #:property prop:custom-write
  (λ (v out _)
    (fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-target-date v))
    (for ([(n v) (in-hash (nutrient-target-nutrient-values v))])
      (fprintf out
               "~a ~a\n"
               (~a (nutrient-canonical-name n) #:min-width 14)
               (~a v #:max-width 6 #:align 'right)))))

(define nutrient-target-id? exact-nonnegative-integer?)
(define nutrient-target-or-id/c (or/c nutrient-target? nutrient-target-id?))

(define (->nt-id nt-or-id)
  (match nt-or-id
    [(? nutrient-target-id? id) id]
    [(nutrient-target id _ _) id]))

;; CREATE

(define (create-nutrient-target! target-date nutrient-values)
  (or (get-nutrient-target #:date target-date)
      (with-tx
       (query-exec (current-conn) (insert #:into nutrient_targets #:set [target_date ,target-date]))
       (define nt-id
         (query-value (current-conn)
                      (select id #:from nutrient_targets #:where (= target_date ,target-date))))
       (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 #:date target-date))))

;; 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 grouped-row)
  (match-define (vector nt-id target-date residuals) grouped-row)
  (nutrient-target nt-id target-date (residuals->nutrient-value-hash residuals)))

(define (get-nutrient-targets)
  (define grouped-rows
    (query-rows (current-conn)
                (select nt.id
                        nt.target_date
                        n.id
                        n.canonical_name
                        n.french_name
                        n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:order-by nt.target_date
                        #:desc)
                #:group '#(0 1)))
  (map grouped-row->nutrient-target grouped-rows))

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

(define (get-nutrient-target-values nt-or-id)
  (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
              (in-query (current-conn)
                        (select n.id
                                n.canonical_name
                                n.french_name
                                n.formula
                                nv.value_ppm
                                #:from (TableExpr:AST ,joined)
                                #:where (= nt.id ,(->nt-id nt-or-id))))])
    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))

(define (get-nutrient-target-value nt-or-id nutrient)
  (query-maybe-value (current-conn)
                     (select value_ppm
                             #:from (TableExpr:AST ,joined)
                             #:where (and (= nt.id ,(->nt-id nt-or-id))
                                          (= 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.target_date
                             #:desc
                             #:limit 1)))

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

;; UPDATE

;; DELETE

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

(module+ test
  (require rackunit
           rackunit/text-ui
           "../db/conn.rkt"
           "../db/migrations.rkt"
           "../models/nutrient.rkt")

  (define target-date "2025-09-01")

  (run-tests
   (test-suite "Nutrient target model"
     #:before (λ ()
                (connect! #:path 'memory)
                (migrate-all!)
                (create-nutrient! "Nitrogen" "" "N")
                (create-nutrient! "Phosphorus" "" "P")
                (create-nutrient! "Potassium" "" "K"))
     #:after (λ () (disconnect!))

     (test-case "Create target with date and values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))
       (create-nutrient-target! target-date (hash nitrogen 12.3 phosphorus 4.5))
       (check-equal? (length (get-nutrient-targets)) 1)
       (define nt (get-nutrient-target #:date target-date))
       (check-true (nutrient-target? nt))
       (check-equal? (nutrient-target-target-date nt) target-date))

     (test-case "Check all target values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))

       (define nt (get-nutrient-target #:date target-date))
       (check-equal? (get-nutrient-target-value nt nitrogen) 12.3)
       (check-equal? (get-nutrient-target-value nt phosphorus) 4.5)

       (define ntv (nutrient-target-nutrient-values nt))
       (check-equal?
        (get-nutrient-target-values nt)
        ntv
        "return value of get-nutrient-target-values ≠ nutrient-target-values struct accessor")
       (check-equal? (hash-count ntv) 2)
       (check-equal? (hash-ref ntv nitrogen) 12.3)
       (check-equal? (hash-ref ntv phosphorus) 4.5))

     (test-case "Retrieve latest target values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))
       (define second-target-date "2025-09-02")
       (create-nutrient-target! second-target-date (hash nitrogen 6.7 phosphorus 8.9))

       (check-equal? (get-latest-nutrient-target-value nitrogen) 6.7)
       (check-equal? (get-latest-nutrient-target-value phosphorus) 8.9))

     (test-case "Delete target and cascade to target values"
       (define nt (get-nutrient-target #:date target-date))
       (delete-nutrient-target! nt)
       (check-false (get-nutrient-target #:id (nutrient-target-id nt)))
       (check-equal? (length (get-nutrient-targets))
                     1
                     "wrong number of nutrient targets were deleted")
       (check-true (hash-empty? (get-nutrient-target-values nt)))))))