#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) (crop?) crop-requirement?)]
          [get-crop-requirements (-> (listof crop-requirement?))]
          [get-crop-requirement (->* () (#:id db-id? #:profile 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? maybe-nutrient-value?)]
          [delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
          [average-crop-requirement-nutrient-values
           (-> (hash/c crop-requirement? (between/c 0 100)) nutrient-value-hash/c)]))

(require racket/contract
         db
         sql
         "../db/conn.rkt"
         "nutrient.rkt"
         "nutrient-value.rkt"
         "crop.rkt"
         "utils.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-or-id/c (or/c crop-requirement? db-id?))

(define (->cr-id cr-or-id)
  (match cr-or-id
    [(? db-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 grouped-row)
  (match-define (vector cr-id profile crop-id residuals) grouped-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)))
  (map grouped-row->crop-requirement grouped-rows))

(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 grouped-row) (grouped-row->crop-requirement grouped-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)]) ([(crop-requirement percentage) (in-hash mix)])
    (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))))

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

  (define requirement-profile "Tomato - Vegetative")

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

     (test-case "Create requirement with profile and values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))

       (create-crop-requirement! requirement-profile (hash nitrogen 150 phosphorus 50))

       (check-equal? (length (get-crop-requirements)) 1)

       (define cr (get-crop-requirement #:profile requirement-profile))
       (check-true (crop-requirement? cr))
       (check-equal? (crop-requirement-profile cr) requirement-profile))

     (test-case "Create requirement with associated crop"
       (define tomato (create-crop! "Tomato"))
       (define nitrogen (get-nutrient #:name "Nitrogen"))

       (define cr (create-crop-requirement! "Tomato - Fruiting" (hash nitrogen 200) tomato))

       (check-equal? (crop-requirement-crop-id cr) (crop-id tomato)))

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

       (define cr (get-crop-requirement #:profile requirement-profile))

       (check-= (get-crop-requirement-value cr nitrogen) 150 0)
       (check-= (get-crop-requirement-value cr phosphorus) 50 0)

       (define crv (crop-requirement-nutrient-values cr))

       (check-equal?
        (get-crop-requirement-values cr)
        crv
        "return value of get-crop-requirement-values ≠ crop-requirement-values struct accessor")

       (check-equal? (hash-count crv) 2)
       (check-= (hash-ref crv nitrogen) 150 0)
       (check-= (hash-ref crv phosphorus) 50 0))

     (test-case "Get requirement by id"
       (define cr (get-crop-requirement #:profile requirement-profile))
       (define cr-by-id (get-crop-requirement #:id (crop-requirement-id cr)))

       (check-equal? cr cr-by-id))

     (test-case "Average crop requirement nutrient values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))

       (define cr1 (get-crop-requirement #:profile requirement-profile))
       (define cr2 (create-crop-requirement! "Lettuce" (hash nitrogen 100 phosphorus 30)))

       (define mix (hash cr1 60 cr2 40))
       (define avg (average-crop-requirement-nutrient-values mix))

       ;; 150 * 0.6 + 100 * 0.4 = 90 + 40 = 130
       (check-= (hash-ref avg nitrogen) 130 0.01)
       ;; 50 * 0.6 + 30 * 0.4 = 30 + 12 = 42
       (check-= (hash-ref avg phosphorus) 42 0.01))

     (test-case "Delete requirement and cascade to requirement values"
       (define cr (get-crop-requirement #:profile requirement-profile))
       (delete-crop-requirement! cr)
       (check-false (get-crop-requirement #:id (crop-requirement-id cr)))
       (check-equal? (length (get-crop-requirements))
                     2
                     "wrong number of crop requirements were deleted")
       (check-true (hash-empty? (get-crop-requirement-values cr)))))))