#lang racket/base
(require racket/match
         net/url
         setup/dirs
         "../path.rkt"
         "config.rkt"
         "lock.rkt"
         "pkg-db.rkt"
         "desc.rkt"
         "params.rkt"
         "install.rkt"
         "repo-path.rkt"
         "dirs.rkt"
         "print.rkt")

(provide pkg-migrate
         pkg-migrate-available-versions)

(define (pkg-migrate from-version
                     #:all-platforms? [all-platforms? #f]
                     #:force? [force? #f]
                     #:quiet? [quiet? #f]
                     #:from-command-line? [from-command-line? #f]
                     #:ignore-checksums? [ignore-checksums? #f]
                     #:strict-doc-conflicts? [strict-doc-conflicts? #f]
                     #:use-cache? [use-cache? #t]
                     #:dep-behavior [dep-behavior #f]
                     #:strip [strip-mode #f]
                     #:force-strip? [force-strip? #f]
                     #:dry-run? [dry-run? #f])
  (define from-db
    ((if (equal? (current-pkg-scope-version) from-version)
         (lambda (f) (f))
         call-with-separate-lock)
     (lambda ()
       (parameterize ([current-pkg-scope-version from-version])
         (installed-pkg-table #:scope 'user)))))
  (define installed-dir
    (parameterize ([current-pkg-scope 'user])
      (pkg-installed-dir)))
  (define (path->complete-string p)
    (path->string (path->complete-path p installed-dir)))
  (define to-install
    (sort
     (for/list ([(name info) (in-hash from-db)]
                #:unless (pkg-info-auto? info))
       (define-values (source type dir)
         (match (pkg-info-orig-pkg info)
           [(list* 'catalog name _) (values name 'name #f)]
           [(list 'url url) (values url #f #f)]
           [(list 'link path) (values (path->complete-string path) 'link #f)]
           [(list 'static-link path) (values (path->complete-string path) 'static-link #f)]
           [(list 'clone path url) (values url 'clone (enclosing-path-for-repo
                                                       url
                                                       (path->complete-path path installed-dir)))]
           [(list 'git url) (values url 'git-url #f)]))
       (pkg-desc source type name #f #f dir))
     string<?
     #:key pkg-desc-name))
  (unless quiet?
    (cond
     [(null? to-install)
      (printf "No packages from ~s to install\n" from-version)]
     [else
      (printf "Packages to install:\n")
      (for ([d (in-list to-install)])
        (define t (pkg-desc-type d))
        (define n (pkg-desc-name d))
        (case t
          [(name) (printf "  ~a\n" n)]
          [(link static-link)
           (printf "  ~a ~aed from ~a\n" n t (pkg-desc-source d))]
          [else
           (printf "  ~a from ~a\n" n (pkg-desc-source d))]))]))
  (if (null? to-install)
      'skip
      (begin0
       (pkg-install to-install
                    #:all-platforms? all-platforms?
                    #:force? force?
                    #:ignore-checksums? ignore-checksums?
                    #:strict-doc-conflicts? strict-doc-conflicts?
                    #:use-cache? use-cache?
                    #:skip-installed? #t
                    #:skip-auto-installed? #t
                    #:dep-behavior (or dep-behavior 'search-auto)
                    #:quiet? quiet? 
                    #:from-command-line? from-command-line?
                    #:strip strip-mode
                    #:force-strip? force-strip?
                    #:dry-run? dry-run?)
       (unless quiet?
         (printf "Packages migrated~a\n" (dry-run-explain dry-run?))))))

(define (pkg-migrate-available-versions)
  (define d (find-system-path 'addon-dir))
  (for/list ([p (in-list (directory-list d))]
             #:when (let ([p (build-path d p "pkgs" "pkgs.rktd")])
                      (file-exists? p))
             #:unless (equal? (path-element->string p)
                              (get-installation-name)))
    (path-element->string p)))
