suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added docs and contracts for some of the planet functions

Browse Source
This commit is contained in:
Robby Findler 2010-06-19 16:27:43 -05:00
parent 0aae2c866f
commit 66d6759c4a
3 changed files with 79 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/planet/planet.scrbl
View File

@ -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?

91
collects/planet/resolver.rkt
View File

@ -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)

12
collects/planet/util.rkt
View File

@ -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