#lang racket

(provide crop-requirement
         crop-requirement?
         crop-requirement-id
         crop-requirement-profile
         crop-requirement-crop-id
         (rename-out [crop-requirement-nutrient-values crop-requirement-values])
         (contract-out [create-crop-requirement!
                        (->* (string? nutrient-value-hash/c) ((or/c #f crop?)) crop-requirement?)]
                       [get-crop-requirements (-> (listof crop-requirement?))]
                       [get-crop-requirement
                        (->* ()
                             (#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
                             (or/c crop-requirement? #f))]
                       [get-crop-requirement-values
                        (-> crop-requirement-or-id/c nutrient-value-hash/c)]
                       [get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? number?)]
                       [delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
                       [average-crop-requirement-nutrient-values
                        (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
                            nutrient-value-hash/c)]))

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

(struct crop-requirement (id profile crop-id nutrient-values)
  #:transparent
  #:guard (λ (id profile crop-id nutrient-values _)
            (values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values)))

(define crop-requirement-id? exact-nonnegative-integer?)

(define crop-requirement-or-id/c (or/c crop-requirement? crop-requirement-id?))

(define (->cr-id cr-or-id)
  (match cr-or-id
    [(? crop-requirement-id? cr-or-id) cr-or-id]
    [(crop-requirement id _ _ _) id]))

;; CREATE

(define (create-crop-requirement! profile nutrient-values [crop #f])
  (or
   (get-crop-requirement #:profile profile)
   (with-tx
    (query-exec
     (current-conn)
     (if crop
         (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile])
         (insert #:into crop_requirements #:set [profile ,profile])))
    (define cr-id
      (query-value (current-conn) (select id #:from crop_requirements #:where (= profile ,profile))))
    (query-exec (current-conn) (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id]))
    (define nvs-id
      (query-value (current-conn)
                   (select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-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-crop-requirement #:profile profile))))

;; READ

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

(define (grouped-row->crop-requirement row)
  (match-define (vector cr-id profile crop-id residuals) row)
  (crop-requirement cr-id profile crop-id (residuals->nutrient-value-hash residuals)))

(define (get-crop-requirements)
  (define grouped-rows
    (query-rows (current-conn)
                (select cr.id
                        cr.profile
                        cr.crop_id
                        n.id
                        n.canonical_name
                        n.french_name
                        n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:order-by cr.id
                        #:asc)
                #:group '#(0 1 2)))
  (for/list ([row grouped-rows])
    (grouped-row->crop-requirement row)))

(define (get-crop-requirement #:id [cr-id #f] #:profile [profile #f] #:crop-id [crop-id #f])
  (define where
    (cond
      [(and cr-id profile crop-id)
       (scalar-expr-qq (and (= cr.id ,cr-id) (= cr.profile ,profile) (= cr.crop_id ,crop-id)))]
      [cr-id (scalar-expr-qq (= cr.id ,cr-id))]
      [profile (scalar-expr-qq (= cr.profile ,profile))]
      [crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))]
      [else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")]))
  (define grouped-rows
    (query-rows (current-conn)
                (select cr.id
                        cr.profile
                        cr.crop_id
                        n.id
                        n.canonical_name
                        n.french_name
                        n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:where (ScalarExpr:AST ,where))
                #:group '#(0 1 2)))
  (match grouped-rows
    ['() #f]
    [(list row) (grouped-row->crop-requirement row)]
    [many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))

(define (get-crop-requirement-values cr-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 (= cr.id ,(->cr-id cr-or-id))))])
    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))

(define (get-crop-requirement-value cr-or-id nutrient)
  (query-maybe-value (current-conn)
                     (select value_ppm
                             #:from (TableExpr:AST ,joined)
                             #:where (and (= cr.id ,(->cr-id cr-or-id))
                                          (= nv.nutrient_id ,(nutrient-id nutrient))))))

;; UPDATE

;; DELETE

(define (delete-crop-requirement! cr-or-id)
  (query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,(->cr-id cr-or-id)))))

;; Helpers

(define (average-crop-requirement-nutrient-values mix)
  (for/fold ([acc (hash)]) ([pair (in-list mix)])
    (match-define (cons crop-requirement percentage) pair)
    (define weight (/ percentage 100))
    (for/fold ([acc acc])
              ([(nutrient value) (in-hash (crop-requirement-nutrient-values crop-requirement))])
      (define contribution (* value weight))
      (hash-update acc nutrient (λ (old) (+ old contribution)) 0))))