#lang racket/base
(require racket/contract/base
         racket/format
         racket/set
         racket/path
         racket/file
         version/utils
         db)

(provide 
 (struct-out pkg)
 (contract-out
  [current-pkg-catalog-file
   (parameter/c path-string?)]

  [get-catalogs (-> (listof string?))]
  [set-catalogs! ((listof string?) . -> . void?)]

  [set-pkgs! ((string? (listof (or/c pkg? string?)))
              (#:clear-other-checksums? boolean?)
              . ->* . 
              void?)]

  [get-pkgs (()
             (#:name (or/c #f string?)
                     #:catalog (or/c #f string?))
             . ->* .
             (listof pkg?))]
  [set-pkg! ((string? string? string? string? string? string?)
             (#:clear-other-checksums? boolean?)
             . ->* .
             void?)]

  [get-pkg-modules (string? string? string?
                            . -> . (listof module-path?))]
  [set-pkg-modules! (string? string? string?
                             (listof module-path?)
                             . -> . void?)]

  [get-pkg-dependencies (string? string? string?
                            . -> . (listof dep/c))]
  [set-pkg-dependencies! (string? string? string?
                                  (listof dep/c)
                                  . -> . void?)]

  [get-pkg-tags (string? string?
                            . -> . (listof string?))]
  [set-pkg-tags! (string? string? (listof string?)
                          . -> . void?)]

  [get-module-pkgs (module-path? . -> . (listof pkg?))]

  [get-pkgs-without-modules (()
                             (#:catalog string?)
                             . ->* .
                             (listof pkg?))]))

(define platform/c (or/c string? symbol? regexp?))
(define dep/c (or/c string?
                    (list/c string?)
                    (list/c string? string?)
                    (list/c string? '#:version valid-version?)
                    (list/c string? '#:platform platform/c)
                    (list/c string? '#:version valid-version? '#:platform platform/c)
                    (list/c string? '#:platform platform/c '#:version valid-version?)))

(struct pkg (name catalog author source checksum desc)
  #:transparent)

(define (prepare-catalog-table db)
  (prepare-table db
                 "catalog"
                 (~a "(id SMALLINT,"
                     " url TEXT,"
                     " pos SMALLINT)")))

(define (prepare-pkg-table db)
  (prepare-table db
                 "pkg"
                 (~a "(name TEXT,"
                     " catalog SMALLINT,"
                     " author TEXT,"
                     " source TEXT,"
                     " checksum TEXT,"
                     " desc TEXT)")))

(define (prepare-tags-table db)
  (prepare-table db
                 "tags"
                 (~a "(pkg TEXT,"
                     " catalog TEXT,"
                     " tag TEXT)")))

(define (prepare-modules-table db)
  (prepare-table db
                 "modules"
                 (~a "(name TEXT,"
                     " pkg TEXT,"
                     " catalog SMALLINT,"
                     " checksum TEXT)")))

(define (prepare-dependencies-table db)
  (prepare-table db
                 "dependencies"
                 (~a "(onpkg TEXT,"
                     " onversion TEXT,"
                     " onplatform TEXT,"
                     " pkg TEXT,"
                     " catalog SMALLINT,"
                     " checksum TEXT)")))

(define current-pkg-catalog-file
  (make-parameter (build-path
                   (find-system-path 'addon-dir)
                   (version)
                   "pkgs"
                   "catalog.sqlite")))

(define (call-with-catalog-db proc)
  (define db #f)
  (dynamic-wind
      (lambda ()
        (define file (current-pkg-catalog-file))
        (define dir (path-only file))
        (unless (directory-exists? dir)
          (make-directory* dir))
        (set! db (sqlite3-connect #:database file
                                  #:mode 'create
                                  #:busy-retry-limit +inf.0)))
      (lambda () (proc db))
      (lambda () 
        (disconnect db))))

(define (get-pkgs #:name [name #f]
                  #:catalog [catalog #f])
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (for/list ([row (in-list
                      (apply
                       query-rows
                       db
                       (~a "SELECT K.name, N.url, K.author, K.source, K.checksum, K.desc"
                           " FROM pkg K, catalog N"
                           " WHERE N.id = K.catalog"
                           (if catalog
                               " AND  N.url = $1"
                               "")
                           (if name
                               (~a " AND  K.name = "
                                   (if catalog "$2" "$1"))
                               "")
                           " ORDER BY N.pos")
                       (append
                        (if catalog
                            (list catalog)
                            null)
                        (if name
                            (list name)
                            null))))])
       (pkg (vector-ref row 0)
            (vector-ref row 1)
            (vector-ref row 2)
            (vector-ref row 3)
            (vector-ref row 4)
            (vector-ref row 5))))))

(define (set-pkg! name catalog author source checksum desc
                  #:clear-other-checksums? [clear-other-checksums? (not (equal? checksum ""))])
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (call-with-transaction
      db
      (lambda ()
        (define catalog-id (url->catalog db catalog))
        (query db
               (~a "UPDATE pkg"
                   " SET author=$1, source=$2, checksum=$3, desc=$4"
                   " WHERE name=$5"
                   " AND   catalog=$6")
               author source checksum desc
               name catalog-id)
        (when clear-other-checksums?
          (query-exec db
                      (~a "DELETE FROM modules"
                          " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
                      catalog-id
                      name
                      checksum)
          (query-exec db
                      (~a "DELETE FROM dependencies"
                          " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
                      catalog-id
                      name
                      checksum))
        (void))))))

(define (get-pkg-tags name catalog)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-tags-table db)
     (define catalog-id (url->catalog db catalog))
     (query-list db
                 (~a "SELECT tag FROM tags"
                     " WHERE catalog=$1"
                     "   AND pkg=$2")
                 catalog-id
                 name))))

(define (set-pkg-tags! name catalog tags)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-tags-table db)
     (call-with-transaction
      db
      (lambda ()
        (define catalog-id (url->catalog db catalog))
        (query-exec db
                    (~a "DELETE FROM tags"
                        " WHERE catalog=$1"
                        "   AND pkg=$2")
                    catalog-id
                    name)
        (for ([tag (in-list tags)])
         (query db
                (~a "INSERT INTO tags"
                    " VALUES ($1, $2, $3)")
                name catalog-id tag)))))))

(define (get-pkg-modules name catalog checksum)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-modules-table db)
     (define catalog-id (url->catalog db catalog))
     (map
      string->mod
      (query-list db
                  (~a "SELECT name FROM modules"
                      " WHERE catalog=$1"
                      "  AND pkg=$2"
                      "  AND checksum=$3")
                  catalog-id
                  name
                  checksum)))))

(define (set-pkg-modules! name catalog checksum modules)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-modules-table db)
     (call-with-transaction
      db
      (lambda ()
        (define catalog-id (url->catalog db catalog))
        (query-exec db
                    (~a "DELETE FROM modules"
                        " WHERE catalog=$1"
                        "  AND pkg=$2"
                        "  AND checksum=$3")
                    catalog-id
                    name
                    checksum)
        (for ([mod (in-list modules)])
         (query db
                (~a "INSERT INTO modules"
                    " VALUES ($1, $2, $3, $4)")
                (mod->string mod) name catalog-id checksum)))))))

(define (get-module-pkgs mod)
  (call-with-catalog-db
   (lambda (db)
     (define rows
       (query-rows db
                   (~a "SELECT M.pkg, P.url, M.checksum"
                       " FROM modules M, catalog P"
                       " WHERE M.name = $1"
                       "  AND  M.catalog = P.id")
                   (mod->string mod)))
     (for/list ([row (in-list rows)])
       (pkg (vector-ref row 0)
            (vector-ref row 1)
            ""
            ""
            (vector-ref row 2)
            "")))))

(define (mod->string mp) (~s mp))
(define (string->mod str) (read (open-input-string str)))

(define (get-pkgs-without-modules #:catalog [catalog #f])
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-modules-table db)
     (define rows
       (apply
        query-rows
        db
        (~a "SELECT K.name, N.url, K.checksum"
            " FROM pkg K, catalog N"
            " WHERE N.id = K.catalog"
            (if catalog
                " AND  N.url = $1"
                "")
            " AND NOT EXISTS"
            " (SELECT M.name"
            "  FROM modules M"
            "  WHERE M.pkg = K.name"
            "   AND  M.catalog = K.catalog"
            "   AND  M.checksum = K.checksum)")
        (append
         (if catalog
             (list catalog)
             null))))
     (for/list ([row (in-list rows)])
       (pkg (vector-ref row 0)
            (vector-ref row 1)
            ""
            ""
            (vector-ref row 2)
            "")))))

(define (get-pkg-dependencies name catalog checksum)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-dependencies-table db)
     (define catalog-id (url->catalog db catalog))
     (define rows
       (query-rows db
                   (~a "SELECT onpkg, onversion, onplatform"
                       " FROM dependencies"
                       " WHERE catalog=$1"
                       "  AND pkg=$2"
                       "  AND checksum=$3")
                   catalog-id
                   name
                   checksum))
     (for/list ([row (in-list rows)])
       (define on-pkg (vector-ref row 0))
       (define on-version (vector-ref row 1))
       (define on-platform (vector-ref row 2))
       (cons on-pkg
             (append
              (if (equal? on-version "")
                  null
                  (list '#:version on-version))
              (if (equal? on-platform "")
                  null
                  (list '#:platform (string->platform on-platform)))))))))

(define (set-pkg-dependencies! name catalog checksum dependencies)
  (define (get-keyed l k wrap)
    (define a (memq k l))
    (if a (wrap (cadr a)) ""))
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-dependencies-table db)
     (call-with-transaction
      db
      (lambda ()
        (define catalog-id (url->catalog db catalog))
        (query-exec db
                    (~a "DELETE FROM dependencies"
                        " WHERE catalog=$1"
                        "  AND pkg=$2"
                        "  AND checksum=$3")
                    catalog-id
                    name
                    checksum)
        (for ([dep (in-list dependencies)])
         (query db
                (~a "INSERT INTO dependencies"
                    " VALUES ($1, $2, $3, $4, $5, $6)")
                (cond
                 [(string? dep) dep]
                 [else (car dep)])
                (cond
                 [(string? dep) ""]
                 [(and (list? dep) (= 2 (length dep)))
                  (cadr dep)]
                 [else (get-keyed (cdr dep) '#:version values)])
                (cond
                 [(string? dep) ""]
                 [(and (list? dep) (= 2 (length dep)))
                  ""]
                 [else (get-keyed (cdr dep) '#:platform platform->string)])
                name catalog-id checksum)))))))

(define (platform->string dep) (~s dep))
(define (string->platform str) (read (open-input-string str)))

(define (get-catalogs)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (query-list db (~a "SELECT url FROM catalog"
                        " ORDER BY pos")))))

(define (set-catalogs! urls)
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-tags-table db)
     (prepare-modules-table db)
     (prepare-dependencies-table db)
     (call-with-transaction
      db
      (lambda ()
        (define current-url+ids
          (query-rows db "SELECT url, id FROM catalog"))
        (define old-urls (for/list ([old (in-list current-url+ids)])
                           (vector-ref old 0)))
        (for ([old (in-list current-url+ids)])
          (define old-url (vector-ref old 0))
          (define old-id (vector-ref old 1))
          (unless (member old-url urls)
            (query-exec db
                        "DELETE FROM catalog WHERE id=$1"
                        old-id)
            (query-exec db
                        "DELETE FROM pkg WHERE catalog=$1"
                        old-id)
            (query-exec db
                        "DELETE FROM tags WHERE catalog=$1"
                        old-id)
            (query-exec db
                        "DELETE FROM modules WHERE catalog=$1"
                        old-id)
            (query-exec db
                        "DELETE FROM dependencies WHERE catalog=$1"
                        old-id)))
        (for ([new-url (in-list urls)])
          (unless (member new-url old-urls)
            (let loop ([id 0])
              (if (query-maybe-row db
                                   "SELECT url FROM catalog WHERE id=$1"
                                   id)
                  (loop (add1 id))
                  (query-exec db "INSERT INTO catalog VALUES ($1, $2, 0)"
                              id
                              new-url)))))
        (for ([new-url (in-list urls)]
              [pos (in-naturals)])
          (query-exec db (~a "UPDATE catalog"
                             " SET pos = $1"
                             " WHERE url = $2")
                      pos
                      new-url)))))))

(define (url->catalog db url)
  (query-value db
               "SELECT id FROM catalog WHERE url=$1"
               url))

(define (set-pkgs! url pkgs
                   #:clear-other-checksums? [clear-other-checksums? #t])
  (call-with-catalog-db
   (lambda (db)
     (prepare-catalog-table db)
     (prepare-pkg-table db)
     (prepare-modules-table db)
     (prepare-dependencies-table db)
     (call-with-transaction
      db
      (lambda ()
        (define catalog (url->catalog db url))
        (define pkg-names (for/list ([p (in-list pkgs)])
                            (if (pkg? p)
                                (pkg-name p)
                                p)))
        (define current-pkgs
          (query-list db "SELECT name FROM pkg WHERE catalog=$1"
                      catalog))
        (define new-pkgs (list->set pkg-names))
        (define old-pkgs (list->set current-pkgs))
        (for ([old (in-list current-pkgs)])
          (unless (set-member? new-pkgs old)
            (query-exec db
                        "DELETE FROM pkg WHERE catalog=$1 AND name=$2"
                        catalog
                        old)
            (query-exec db
                        "DELETE FROM tags WHERE catalog=$1 AND pkg=$2"
                        catalog
                        old)
            (query-exec db
                        "DELETE FROM modules WHERE catalog=$1 AND pkg=$2"
                        catalog
                        old)
            (query-exec db
                        "DELETE FROM dependencies WHERE catalog=$1 AND pkg=$2"
                        catalog
                        old)))
        (for ([new0 (in-list pkgs)])
          (define new (if (pkg? new0) 
                          new0
                          (pkg new0 "" "" "" "" "")))
          (when (and clear-other-checksums?
                     (not (equal? "" (pkg-checksum new))))
            (query-exec db
                        (~a "DELETE FROM modules"
                            " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
                        catalog
                        (pkg-name new)
                        (pkg-checksum new))
            (query-exec db
                        (~a "DELETE FROM dependencies"
                            " WHERE catalog=$1 AND pkg=$2 AND checksum<>$3")
                        catalog
                        (pkg-name new)
                        (pkg-checksum new)))
          (unless (and (string? new0)
                       (set-member? old-pkgs new0))
            (if (set-member? old-pkgs (pkg-name new))
                (query-exec db
                            (~a "UPDATE pkg"
                                " SET author=$1, source=$2, checksum=$3, desc=$4"
                                " WHERE name=$5"
                                " AND   catalog=$6")
                            (pkg-author new)
                            (pkg-source new)
                            (pkg-checksum new)
                            (pkg-desc new)
                            (pkg-name new)
                            catalog)
                (query-exec db
                            "INSERT INTO pkg VALUES ($1, $2, $3, $4, $5, $6)"
                            (pkg-name new)
                            catalog
                            (pkg-author new)
                            (pkg-source new)
                            (pkg-checksum new)
                            (pkg-desc new))))))))))

(define (prepare-table db which desc)
  (when (null? 
         (query-rows db (~a "SELECT name FROM sqlite_master"
                            " WHERE type='table' AND name='" which "'")))
    (query-exec db (~a "CREATE TABLE " which " "
                       desc))))

;; ----------------------------------------

(module+ main
  (require rackunit
           racket/file)

  (define (pkg<? a b)
    (if (string=? (pkg-name a) (pkg-name b))
        (string<? (pkg-catalog a) (pkg-catalog b))
        (string<? (pkg-name a) (pkg-name b))))

  (parameterize ([current-pkg-catalog-file (make-temporary-file
                                          "~a.sqlite")])
    (check-equal? (get-catalogs) '())

    (set-catalogs! '("http://a" "http://b"))
    (check-equal? (get-catalogs)
                  '("http://a" "http://b"))
    
    (check-equal? (get-pkgs) '())

    
    (set-pkgs! "http://a" '("p1"))
    (check-equal? (get-pkgs) 
                  (list
                   (pkg "p1" "http://a" "" "" "" "")))
    
    (set-pkgs! "http://b" '("p2"))
    (check-equal? (get-pkgs)
                  (list
                   (pkg "p1" "http://a" "" "" "" "")
                   (pkg "p2" "http://b" "" "" "" "")))
    (check-equal? (get-pkgs #:catalog "http://a") 
                  (list
                   (pkg "p1" "http://a" "" "" "" "")))
    (check-equal? (get-pkgs #:name "p1")
                  (list
                   (pkg "p1" "http://a" "" "" "" "")))
    
    (set-pkg! "p1" "http://a" "github:a" "adam" "123" "the first package")
    (check-equal? (get-pkgs)
                  (list
                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")
                   (pkg "p2" "http://b" "" "" "" "")))

    ;; reverse order of catalogs:
    (set-catalogs! '("http://b" "http://a"))
    (check-equal? (get-catalogs)
                  '("http://b" "http://a"))
    (check-equal? (get-pkgs)
                  (list
                   (pkg "p2" "http://b" "" "" "" "")
                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))

    (check-equal? (get-pkg-tags "p2" "http://b")
                  '())
    (set-pkg-tags! "p2" "http://b" '("2x" "2y" "2z"))
    (check-equal? (sort (get-pkg-tags "p2" "http://b") string<?)
                  '("2x" "2y" "2z"))
    (check-equal? (get-pkg-tags "p1" "http://a")
                  '())
    
    (set-pkg-modules! "p1" "http://a" "123" (list '(lib "lib1/main.rkt")
                                                  '(lib "lib2/main.rkt")))
    (check-equal? (sort (get-pkg-modules "p1" "http://a" "123")
                        string<?
                        #:key cadr)
                  (list '(lib "lib1/main.rkt")
                        '(lib "lib2/main.rkt")))
    (check-equal? (get-module-pkgs '(lib "lib1/main.rkt"))
                  (list
                   (pkg "p1" "http://a" "" "" "123" "")))

    (set-pkg-dependencies! "p1" "http://a" "123" (list "p7"
                                                       '("p8" "8.0")
                                                       '("p9" #:version "9.0")
                                                       '("p10" #:platform #rx"linux")
                                                       '("p11" #:platform 'windows)
                                                       '("p12" #:version "1.2" #:platform 'macosx)
                                                       '("p13" #:platform 'unix #:version "1.3.2")
                                                       '("p14" #:platform "")))
    (check-equal? (sort (get-pkg-dependencies "p1" "http://a" "123")
                        string<?
                        #:key car)
                  '(("p10" #:platform #rx"linux")
                    ("p11" #:platform 'windows)
                    ("p12" #:version "1.2" #:platform 'macosx)
                    ("p13" #:version "1.3.2" #:platform 'unix)
                    ("p14" #:platform "")
                    ("p7")
                    ("p8" #:version "8.0")
                    ("p9" #:version "9.0")))

    (set-catalogs! '("http://a" "http://c"))
    (check-equal? (sort (get-catalogs) string<?) 
                  '("http://a" "http://c"))

    (check-equal? (get-pkgs) 
                  (list
                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))

    (delete-file (current-pkg-catalog-file))

    (void)))