#lang typed/racket

(require typed/db)
(require "../entities/article.rkt")
(require "../db/connection.rkt")
(require "../db/articles.rkt")
(require "../db/tags.rkt")
(require "../readers/article.rkt")

(: make-db-conn (-> String String Connection))
(define (make-db-conn database user)
  (connect #:database database #:user user #:socket 'guess))

(: register-articles (-> Connection Path-String Void))
(define (register-articles db-conn path)
  (define article-hashes (fetch-article-hashes db-conn))
  (call-with-input-file path
    (lambda ([in : Input-Port])
      (for/fold
          ([tag-ids : (Immutable-HashTable String Integer)
                    (fetch-tag-ids db-conn)])
          ([article (in-port read-article in)])
        (cond
          [(hash-ref article-hashes (article-id article) #f)
           => (lambda ([h : String])
                (cond
                  [(string=? h (article-hash article)) tag-ids]
                  [else
                   (update-article db-conn article)
                   (begin0 (register-tags db-conn article tag-ids)
                     (displayln (format "updated: ~a, ~a"
                                (article-id article)
                                (article-title article))))]))]
          [else
           (insert-article db-conn article)
           (begin0 (register-tags db-conn article tag-ids)
             (displayln (format "registered: ~a, ~a"
                                (article-id article)
                                (article-title article))))]))))
  (void))

(: register-tags (-> Connection
                     Article-With-Tags
                     (Immutable-HashTable String Integer)
                     (Immutable-HashTable String Integer)))
(define (register-tags db-conn article tag-ids)
  (define (register-new-tags)
    (for/fold ([s : (Setof Integer)
                  (set)]
               [tag-ids : (Immutable-HashTable String Integer)
                        tag-ids]
               [taggings : (Setof Integer)
                         (fetch-article-taggings db-conn (article-id article))])
              ([tag (article-tags article)])
      (cond [(hash-ref tag-ids tag #f)
             => (lambda ([tag-id : Integer])
                  (values (set-add s tag-id)
                          tag-ids
                          taggings))]
            [else
             (let ([tag-id : Integer (insert-tag db-conn tag)])
               (insert-article-tagging db-conn (article-id article) tag-id)
               (values (set-add s tag-id)
                       (hash-set tag-ids tag tag-id)
                       (set-add taggings tag-id)))])))
  (let-values ([(current-tag-ids tag-ids taggings)
                (register-new-tags)])
    (for ([tag-id (in-set (set-subtract taggings current-tag-ids))])
      (delete-article-tagging db-conn (article-id article) tag-id))
    tag-ids))

(module+ main
  (require racket/cmdline)
  (define database (box "diary"))
  (define username (box "postgres"))
  (command-line #:program "register-articles"
                #:once-each
                [("-d" "--database") name
                                     "Database name"
                                     (set-box! database (assert name string?))]
                [("-u" "--user") name
                                 "Username"
                                 (set-box! username (assert (assert name string?)))]
                #:args (filename)
                (let ([db-conn (make-db-conn (unbox database) (unbox username))])
                  (call-with-transaction db-conn
                    (thunk
                     (register-articles db-conn (assert filename string?)))))))