(module yppdb-db mzscheme
  (require (lib "contract.ss")
           (lib "list.ss")
           (lib "plt-match.ss")
           (lib "struct.ss"))
  (require (planet "maybe.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "list.ss" ("jaymccarthy" "mmss.plt" 1)))
  
  ;; Paper
  (define-struct paper (id title author year categories url read notes))
  (provide/contract
   [struct paper ([id number?]
                  [title string?]
                  [author string?]
                  [year number?]
                  [categories (listof symbol?)]
                  [url string?]
                  [read boolean?]
                  [notes string?])])
  
  (define empty-paper (make-paper -1 "" "" 1778 empty "" #f ""))
  (provide/contract
   [empty-paper paper?])
  
  ;; Paper list
  (define-struct paper-db (path categories paper-list))
  
  (define paper-list (make-nothing))
  
  (define (paper-list-load path-to-db)
    (with-handlers ([exn? (lambda _ 
                            (set! paper-list
                                  (make-just 
                                   (make-paper-db path-to-db
                                                  empty
                                                  empty))))])
      (match (with-input-from-file path-to-db read)
        [(list _categories _papers)
         (set! paper-list
               (make-just
                (make-paper-db path-to-db
                               _categories
                               (map (lambda (p)
                                      (apply make-paper p))
                                    _papers))))])))
  (provide/contract
   [paper-list-load (path? . -> . void?)])
  
  (define paper-list-write
    (match-lambda
      [(struct paper-db (path cats papers))
       (with-output-to-file path
         (lambda ()
           (write
            (list cats
                  (map (lambda (p)
                         (list (paper-id p)
                               (paper-title p)
                               (paper-author p)
                               (paper-year p)
                               (paper-categories p)
                               (paper-url p)
                               (paper-read p)
                               (paper-notes p)))
                       papers))))
         'truncate/replace)]))
  
  (define (next-paper-id)
    (if (empty? (paper-list/all))
        0
        (add1 (paper-id (first (paper-list/all))))))
  
  (define (paper-list-replace old new)
    (let ([new-list 
           (if (eq? old empty-paper)
               (list* (copy-struct paper new
                                   [paper-id (next-paper-id)])
                      (paper-list/all))
               (replace/op (lambda (p)
                             (equal? (paper-id p) (paper-id old)))
                           (lambda (p)
                             new)
                           (paper-list/all)))])
      (set! paper-list
            (make-just
             (copy-struct paper-db (just-value paper-list)
                          [paper-db-categories
                           (quicksort (list->unique-list
                                       (append (paper-categories new)
                                               (paper-list-categories)))
                                      (<=/proj string-ci<=? symbol->string))]
                          [paper-db-paper-list
                           new-list]))))
    (paper-list-write (just-value paper-list))
    new)
  (provide/contract
   [paper-list-replace (paper? paper? . -> . paper?)])
  
  (define (paper-list/search field value)
    (let ([value (string-downcase value)])
      (filter (match field
                ["author"
                 (lambda (p) (regexp-match value (string-downcase (paper-author p))))]
                ["title"
                 (lambda (p) (regexp-match value (string-downcase (paper-title p))))]
                ["year"
                 (lambda (p) (equal? (string->number p) (paper-year p)))]
                ["notes"
                 (lambda (p) (regexp-match value (string-downcase (paper-notes p))))])
              (paper-list/all))))
  (provide/contract
   [paper-list/search (string? string? . -> . (listof paper?))])
  
  (define (paper-list/all)
    (paper-db-paper-list (just-value paper-list)))
  (provide/contract
   [paper-list/all (-> (listof paper?))])
  
  (define (paper-list-categories)
    (quicksort (paper-db-categories (just-value paper-list))
               (<=/proj string-ci<=? symbol->string)))
  (provide/contract
   [paper-list-categories (-> (listof symbol?))]))