From 66d6759c4af5c93b69163fe236992052e7bda347 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 19 Jun 2010 16:27:43 -0500 Subject: [PATCH] added docs and contracts for some of the planet functions --- collects/planet/planet.scrbl | 26 +++++++++++ collects/planet/resolver.rkt | 91 ++++++++++++++++++------------------ collects/planet/util.rkt | 12 +++-- 3 files changed, 79 insertions(+), 50 deletions(-) diff --git a/collects/planet/planet.scrbl b/collects/planet/planet.scrbl index b272d032fe..0c4481c738 100644 --- a/collects/planet/planet.scrbl +++ b/collects/planet/planet.scrbl @@ -576,6 +576,32 @@ package name, major and minor version number. Returns false if no such package is available; otherwise returns a package structure for the installed package.} +@defproc[(install-pkg [pkg pkg-spec?] + [file path-string?] + [maj natural-number/c] + [min natural-number/c]) + (or/c pkg? #f)]{ + Installs the package represented by the arguments, using + only the @scheme[pkg-spec-path] and @racket[pkg-spec-name] + fields of @scheme[pkg]. + + Returns a new @racket[pkg-spec?] corresponding to the package + that was actually installed. +} + +@defproc[(get-package-spec [owner string?] + [pkg string?] + [maj (or/c #f natural-number/c) #f] + [min (or/c #f natural-number/c) #f]) + pkg-spec?]{ + Builds a @racket[pkg-spec?] corresponding to the package specified by + @racket[owner], @racket[pkg], @scheme[maj], and @scheme[min]. +} + +@defproc[(pkg-spec? [v any/c]) boolean?]{ + Recognizes the result of @racket[get-package-spec]. +} + @defparam[current-cache-contents contents (listof (list/c string? diff --git a/collects/planet/resolver.rkt b/collects/planet/resolver.rkt index 3cc8708e03..e04b0705c5 100644 --- a/collects/planet/resolver.rkt +++ b/collects/planet/resolver.rkt @@ -550,51 +550,52 @@ subdirectory. ;; install the given pkg to the planet cache and return a PKG representing the ;; installed file (define (install-pkg pkg path maj min) - (unless (install?) - (raise (make-exn:fail:planet - (format - "PLaneT error: cannot install package ~s since the install? parameter is set to #f" - (list (car (pkg-spec-path pkg)) (pkg-spec-name pkg) maj min)) - (current-continuation-marks)))) - (let* ([owner (car (pkg-spec-path pkg))] - [extra-path (cdr (pkg-spec-path pkg))] - [the-dir - (apply build-path (CACHE-DIR) - (append (pkg-spec-path pkg) (list (pkg-spec-name pkg) - (number->string maj) - (number->string min))))] - [was-nested? (planet-nested-install)]) - (if (directory-exists? the-dir) - (raise (make-exn:fail - "Internal PLaneT error: trying to install already-installed package" - (current-continuation-marks))) - (parameterize ([planet-nested-install #t]) - (planet-terse-log 'install (pkg-spec->string pkg)) - (with-logging - (LOG-FILE) - (lambda () - (printf "\n============= Installing ~a on ~a =============\n" - (pkg-spec-name pkg) - (current-time)) - ;; oh man is this a bad hack! - (parameterize ([current-namespace (make-namespace)]) - (printf "new namespace\n") - (let ([ipp (dynamic-require 'setup/plt-single-installer - 'install-planet-package)] - [rud (dynamic-require 'setup/plt-single-installer - 'reindex-user-documentation)] - [msfh (dynamic-require 'compiler/cm 'manager-skip-file-handler)]) - (printf "starting setup-plt ~s ~s\n" (manager-skip-file-handler) (msfh)) - (parameterize ([msfh (manager-skip-file-handler)]) - (printf "starting setup-plt.2 ~s ~s\n" (manager-skip-file-handler) (msfh)) - (ipp path the-dir (list owner (pkg-spec-name pkg) - extra-path maj min)) - (unless was-nested? - (printf "------------- Rebuilding documentation index -------------\n") - (rud))))))) - (planet-terse-log 'finish (pkg-spec->string pkg)) - (make-pkg (pkg-spec-name pkg) (pkg-spec-path pkg) - maj min the-dir 'normal))))) + (printf "~s\n" (list 'install-pkg pkg path maj min)) + (let ([pkg-path (pkg-spec-path pkg)] + [pkg-name (pkg-spec-name pkg)] + [pkg-string (pkg-spec->string pkg)]) + (unless (install?) + (raise (make-exn:fail:planet + (format + "PLaneT error: cannot install package ~s since the install? parameter is set to #f" + (list (car pkg-path) pkg-name maj min)) + (current-continuation-marks)))) + (let* ([owner (car pkg-path)] + [extra-path (cdr pkg-path)] + [the-dir + (apply build-path (CACHE-DIR) + (append pkg-path (list pkg-name + (number->string maj) + (number->string min))))] + [was-nested? (planet-nested-install)]) + (if (directory-exists? the-dir) + (raise (make-exn:fail + "PLaneT error: trying to install already-installed package" + (current-continuation-marks))) + (parameterize ([planet-nested-install #t]) + (planet-terse-log 'install pkg-string) + (with-logging + (LOG-FILE) + (lambda () + (printf "\n============= Installing ~a on ~a =============\n" + pkg-name + (current-time)) + ;; oh man is this a bad hack! + (parameterize ([current-namespace (make-namespace)]) + (let ([ipp (dynamic-require 'setup/plt-single-installer + 'install-planet-package)] + [rud (dynamic-require 'setup/plt-single-installer + 'reindex-user-documentation)] + [msfh (dynamic-require 'compiler/cm 'manager-skip-file-handler)]) + (parameterize ([msfh (manager-skip-file-handler)]) + (ipp path the-dir (list owner pkg-name + extra-path maj min)) + (unless was-nested? + (printf "------------- Rebuilding documentation index -------------\n") + (rud))))))) + (planet-terse-log 'finish pkg-string) + (make-pkg pkg-name pkg-path + maj min the-dir 'normal)))))) ;; download-package : FULL-PKG-SPEC -> RESPONSE ;; RESPONSE ::= (list #f string) | (list #t path[file] Nat Nat) diff --git a/collects/planet/util.rkt b/collects/planet/util.rkt index 7298c9f3ab..8f263e7b07 100644 --- a/collects/planet/util.rkt +++ b/collects/planet/util.rkt @@ -44,10 +44,10 @@ display-plt-file-structure display-plt-archived-file get-package-from-cache - install-pkg pkg->download-url exn:fail:planet? - make-exn:fail:planet) + make-exn:fail:planet + pkg-spec?) (provide/contract [get-package-spec @@ -55,10 +55,12 @@ [download-package (-> pkg-spec? (or/c string? - (list/c (λ (x) (eq? x #t)) path? natural-number/c natural-number/c) - (list/c false/c string?)))] + (list/c #t path? natural-number/c natural-number/c) + (list/c #f string?)))] [download/install-pkg - (-> string? string? natural-number/c any/c (or/c pkg? false/c))] + (-> string? string? natural-number/c any/c (or/c pkg? #f))] + [install-pkg + (-> pkg-spec? string? natural-number/c any/c (or/c pkg? #f))] [add-hard-link (-> string? string? natural-number/c natural-number/c path? void?)] [remove-hard-link