#lang racket

(provide
 ;; Struct definitions
 fertilizer-product
 fertilizer-product?
 fertilizer-product-id fertilizer-product-brand-name
 (rename-out
  [fertilizer-product-nutrient-values fertilizer-product-values])
 ;; SQL CRUD
 (contract-out
  [create-fertilizer-product! (->* (string?
                                    (listof (cons/c nutrient? number?)))
                                   (string?)
                                   fertilizer-product?)]
  [get-fertilizer-products (-> (listof fertilizer-product?))]
  [get-fertilizer-product (->* ()
                               (#:id (or/c #f exact-nonnegative-integer?)
                                #:canonical-name (or/c #f string?))
                               (or/c fertilizer-product? #f))]
  [get-fertilizer-product-values (-> fertilizer-product?
                                     (listof (cons/c nutrient? number?)))]
  [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
  [delete-fertilizer-product! (-> fertilizer-product? void?)]))

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

;; Instances of this struct are persisted in the fertilizer_products table.
(struct fertilizer-product (id canonical-name nutrient-values brand-name) #:transparent)


;; CREATE

(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
  (or (get-fertilizer-product #:canonical-name canonical-name)
      (with-tx
        (query-exec (current-conn)
                    (cond
                      [brand-name
                       (insert #:into fertilizer_products
                               #:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
                      [else
                       (insert #:into fertilizer_products
                               #:set [canonical_name ,canonical-name])]))
        (define fp-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
        (query-exec (current-conn)
                    (insert #:into nutrient_value_sets
                            #:set [fertilizer_product_id ,fp-id]))
        (define nvs-id (query-value (current-conn)
                                    (select id
                                            #:from nutrient_value_sets
                                            #:where (= fertilizer_product_id ,fp-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-fertilizer-product #:canonical-name canonical-name))))


;; READ

(struct acc (canonical-name brand-name pairs) #:transparent)

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

(define (get-fertilizer-products)
  (define query (select fp.id fp.canonical_name fp.brand_name
                        n.id n.canonical_name n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:order-by canonical_name #:asc))
  (define rows (query-rows (current-conn) query))
  (define by-id
    (for/fold ([h (hash)]) ([row (in-list rows)])
      (match-define (vector fp-id canonical-name brand-name 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 fp-id
                   (λ (old-acc)
                     (acc (acc-canonical-name old-acc)
                          (acc-brand-name old-acc)
                          (cons nv-pair (acc-pairs old-acc))))
                   (λ ()
                     (acc canonical-name
                          brand-name
                          (list nv-pair))))))
  (for/list ([(id a) (in-hash by-id)])
    (fertilizer-product id
                        (acc-canonical-name a)
                        (reverse (acc-pairs a))
                        (acc-brand-name a))))

(define (get-fertilizer-product #:id [fp-id #f]
                                #:canonical-name [canonical-name #f])
  (define where
    (cond
      [(and fp-id canonical-name)
       (scalar-expr-qq (and (= fp.id ,fp-id)
                            (= fp.canonical_name ,canonical-name)))]
      [fp-id
       (scalar-expr-qq (= fp.id ,fp-id))]
      [canonical-name
       (scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
  (define query (select fp.id fp.canonical_name fp.brand_name
                        n.id n.canonical_name n.formula
                        nv.value_ppm
                        #:from (TableExpr:AST ,joined)
                        #:where (ScalarExpr:AST ,where)
                        #:limit 1))
  (define rows (query-rows (current-conn) query))
  (cond
    [(null? rows) #f]
    [else
     ;; Fold all nutrient value rows belonging to the single fertilizer product into one struct
     (define the-id #f)
     (define A #f)
     (for ([row (in-list rows)])
       (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
       (unless the-id (set! the-id fp-id))
       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
       (set! A (if A
                   (acc (acc-canonical-name A)
                        (acc-brand-name A)
                        (cons nv-pair (acc-pairs A)))
                   (acc canonical-name
                        brand-name
                        (list nv-pair)))))
     (and A
          (fertilizer-product the-id
                              (acc-canonical-name A)
                              (reverse (acc-pairs A))
                              (acc-brand-name A)))]))

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

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


;; UPDATE


;; DELETE

(define (delete-fertilizer-product! fertilizer-product)
  (define id (fertilizer-product-id fertilizer-product))
  (query-exec (current-conn)
              (delete #:from fertilizer_products
                      #:where (= id ,id))))