#lang typed/racket
(require "../entities/article.rkt")
(require typed/db)

(module untyped-db-ops racket
  (require db
           db/util/datetime
           "../entities/article.rkt")

  (provide fetch-article
           fetch-latest-articles
           fetch-article-tags
           fetch-article-taggings
           insert-article-tagging
           delete-article-tagging
           fetch-article-hashes
           update-article
           insert-article)

  (define (fetch-article conn article-id)
    (match-let ([(vector timestamp hash title body)
                 (query-row conn "SELECT timestamp, hash, title, body FROM diary.articles WHERE article_id = $1" article-id)])
      (make-article article-id (sql-datetime->srfi-date timestamp) hash title body)))

  (define (fetch-latest-articles conn limit)
    (define article-list
      (for/list ([(article-id timestamp hash title body)
                  (in-query conn "
SELECT article_id, timestamp, hash, title, body FROM diary.articles ORDER BY timestamp DESC LIMIT $1
"
                            limit)])
        (make-article article-id (sql-datetime->srfi-date timestamp) hash title body)))
    (define article-tags
      (for/hash ([(article-id l)
                  (in-query conn
                            "
SELECT article_id, name FROM diary.tags
  JOIN diary.article_taggings USING (tag_id)
 WHERE article_id = any ($1)
"
                            (map article-id article-list)
                            #:group #("article_id"))])
        (values article-id (vector->list (car l)))))
    (map (lambda (article)
           (cond
             [(hash-ref article-tags (article-id article) #f)
              => (curry article->article-with-tags article)]
             [else
              (article->article-with-tags article '())]))
         article-list))

  (define (fetch-article-tags conn article-id)
    (for/list ([tag (in-query conn "
SELECT name FROM diary.tags
  JOIN diary.article_taggings USING (tag_id)
 WHERE article_id = $1
 ORDER BY name
"
                              article-id)])
      tag))

  (define (delete-article-tagging conn article_id tag_id)
    (query-exec conn
                "
DELETE FROM diary.article_taggings
WHERE article_id = $1
  AND tag_id = $2
"
                article_id
                tag_id))

  (define (fetch-article-taggings conn article-id)
    (for/set ([tag-id (in-query conn "SELECT tag_id FROM diary.article_taggings WHERE article_id = $1" article-id)])
      tag-id))

  (define (insert-article-tagging conn article_id tag_id)
    (query-exec conn
                "
INSERT INTO diary.article_taggings(article_id, tag_id)
VALUES($1, $2)
"
                article_id
                tag_id))

  (define (insert-tag conn name)
    (query-value conn
                 "
INSERT INTO diary.tags(name)
VALUES($1)
RETURNING tag_id
"
                 name))

  (define (fetch-article-hashes conn)
    (for/hash ([(article-id hash)
                (in-query conn "SELECT article_id, hash FROM diary.articles")])
      (values article-id hash)))

  (define (insert-article conn article)
    (query-exec conn
                "
INSERT INTO diary.articles(article_id, timestamp, hash, title, body)
VALUES($1, $2, $3, $4, $5)
"
                (article-id article)
                (srfi-date->sql-timestamp-tz (article-timestamp article))
                (article-hash article)
                (article-title article)
                (article-body article)))

  (define (update-article conn article)
    (query-exec conn
                "
UPDATE diary.articles
   SET timestamp = $2,
       hash = $3,
       title = $4,
       body = $5
 WHERE article_id = $1
       AND hash <> $3
"
                (article-id article)
                (srfi-date->sql-timestamp-tz (article-timestamp article))
                (article-hash article)
                (article-title article)
                (article-body article))))

(require/typed/provide (submod "." untyped-db-ops)
  [fetch-article (-> Connection String Article)]
  [fetch-latest-articles (-> Connection Natural (Listof Article-With-Tags))]
  [fetch-article-tags (-> Connection String (Listof String))]
  [fetch-article-hashes (-> Connection (Immutable-HashTable String String))]
  [fetch-article-taggings (-> Connection String (Setof Integer))]
  [insert-article-tagging (-> Connection String Integer Void)]
  [delete-article-tagging (-> Connection String Integer Void)]
  [update-article (-> Connection Article Void)]
  [insert-article (-> Connection Article Void)])