#lang racket

(provide crop
         crop?
         crop-id
         crop-name
         (contract-out [create-crop! (-> crop? crop?)]
                       [get-crops (-> (listof crop?))]
                       [get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))]
                       [update-crop! (-> crop? void?)]
                       [delete-crop! (-> db-id? void?)]))

(require db
         sql
         "../db/conn.rkt"
         "utils.rkt")

(struct crop (id name) #:transparent)

;; CREATE

(define (create-crop! c)
  (define name (crop-name c))
  (or (get-crop #:name name)
      (with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name]))
               (get-crop #:name name))))

;; READ

(define (get-crops)
  (for/list ([(id* name*) (in-query (current-conn)
                                    (select id canonical_name #:from crops #:order-by id #:asc))])
    (crop id* name*)))

(define (get-crop #:id [id #f] #:name [name #f])
  (define where
    (cond
      [(and id name) (scalar-expr-qq (and (= id ,id) (= canonical_name ,name)))]
      [id (scalar-expr-qq (= id ,id))]
      [name (scalar-expr-qq (= canonical_name ,name))]))
  (define query
    (select id
            canonical_name
            #:from crops
            #:where (ScalarExpr:AST ,where)
            #:order-by id
            #:asc
            #:limit 1))
  (match (query-maybe-row (current-conn) query)
    [(vector id* name*) (crop id* name*)]
    [#f #f]))

;; UPDATE

(define (update-crop! c)
  (define id (or (crop-id c) (raise-argument-error 'update-crop! "db-id?" (crop-id c))))
  (with-tx (query-exec (current-conn)
                       (update crops #:set [canonical_name ,(crop-name c)] #:where [= id ,id]))))

;; DELETE

(define (delete-crop! id)
  (query-exec (current-conn) (delete #:from crops #:where (= id ,id))))

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

  (define test-crop-name "examplium-plant")

  (run-tests (test-suite "Crop model"
               #:before (λ ()
                          (connect! #:path 'memory)
                          (migrate-all!))
               #:after (λ () (disconnect!))

               (test-case "Create crop"
                 (check-equal? (length (get-crops)) 0)
                 (define c1 (create-crop! (crop #f test-crop-name)))
                 (check-equal? (length (get-crops)) 1)
                 (check-true (crop? c1))
                 (check-equal? (crop-name c1) test-crop-name)
                 (check-true (db-id? (crop-id c1))))

               (test-case "Create duplicate crop returns existing"
                 (define c1 (create-crop! (crop #f test-crop-name)))
                 (define c2 (create-crop! (crop #f test-crop-name)))
                 (check-equal? (length (get-crops)) 1)
                 (check-equal? (crop-id c1) (crop-id c2))
                 (check-equal? c1 c2))

               (test-case "Get crop by id"
                 (define c1 (get-crop #:name test-crop-name))
                 (define c2 (get-crop #:id (crop-id c1)))
                 (check-equal? c1 c2))

               (test-case "Get crop by name"
                 (define c (get-crop #:name test-crop-name))
                 (check-true (crop? c))
                 (check-equal? (crop-name c) test-crop-name))

               (test-case "Get crop with both id and name"
                 (define c1 (get-crop #:name test-crop-name))
                 (define c2 (get-crop #:id (crop-id c1) #:name test-crop-name))
                 (check-equal? c1 c2))

               (test-case "Get non-existent crop"
                 (check-false (get-crop #:name "non-existent-crop"))
                 (check-false (get-crop #:id 9999)))

               (test-case "Get all crops"
                 (create-crop! (crop #f "ignorium-plant"))
                 (create-crop! (crop #f "testium-plant"))
                 (define crops (get-crops))
                 (check-equal? (length crops) 3)
                 (check-true (andmap crop? crops)))

               (test-case "Update crop name"
                 (define c1 (get-crop #:name test-crop-name))
                 (define updated-crop (crop (crop-id c1) "examplium-updated"))
                 (update-crop! updated-crop)
                 (define c2 (get-crop #:id (crop-id c1)))
                 (check-equal? (crop-name c2) "examplium-updated")
                 (check-equal? (crop-id c1) (crop-id c2))
                 (check-equal? (length (get-crops)) 3))

               (test-case "Update crop with invalid id raises error"
                 (define invalid-crop (crop #f "invalid"))
                 (check-exn exn:fail:contract? (λ () (update-crop! invalid-crop))))

               (test-case "Delete crop"
                 (define c (get-crop #:name "ignorium-plant"))
                 (delete-crop! (crop-id c))
                 (check-false (get-crop #:id (crop-id c)))
                 (check-equal? (length (get-crops)) 2))

               (test-case "Delete crop by id"
                 (define c (get-crop #:name "testium-plant"))
                 (define crop-id-val (crop-id c))
                 (delete-crop! crop-id-val)
                 (check-false (get-crop #:id crop-id-val))
                 (check-equal? (length (get-crops)) 1)))))