raco pkg catalog-archive: support platform-specific dependencies

This commit is contained in:
Matthew Flatt 2020-04-12 11:19:18 -06:00
parent 5df1b7906b
commit 7ed8ea040e
7 changed files with 41 additions and 11 deletions

View File

@ -498,6 +498,9 @@ for extracting existing catalog information.
[#:relative-sources? relative-sources? boolean? #f]
[#:include includes (or/c #f (listof string?)) #f]
[#:include-deps? include-deps? boolean? #f]
[#:include-deps-sys+subtype include-deps-sys+subtype (or/c #f (cons/c symbol?
path-for-some-system?))
#f]
[#:exclude excludes (listof string?) '()]
[#:fast-file-copy? fast-file-copy? boolean? #f]
[#:quiet? quiet? boolean? #f]
@ -519,6 +522,7 @@ for extracting existing catalog information.
@history[#:added "6.0.1.7"
#:changed "6.0.1.13" @elem{Added the @racket[#:package-exn-handler] argument.}
#:changed "7.7.0.1" @elem{Added the @racket[#:include], @racket[#:include-deps?],
@racket[#:include-deps-platform],
@racket[#:exclude], and @racket[#:fast-file-copy?] arguments.}]}
@defproc[(pkg-archive-pkgs [dest-dir path-string?]

View File

@ -1108,6 +1108,10 @@ for @nonterm{key}.
excluded via @DFlag{exclude}.}
@item{@DFlag{include-deps} --- Modifies the @DFlag{includes} @nonterm{pkg} flag to imply all
dependencies of @nonterm{pkg}.}
@item{@DFlag{include-deps-platform} @nonterm{sys} @nonterm{subpath} --- Modifies @DFlag{include-deps}
to imply only dependencies that match the platform @nonterm{sys}, which should be
a possible result of @racket[(system-type)], and @nonterm{subpath}, which should be
a possible result of @racket[(system-library-subpath #f)]}
@item{@DFlag{exclude} @nonterm{pkg} --- Can be specified multiple times. Removes @nonterm{pkg}
from the set of packages in the archive and generated catalog. If @DFlag{include} is
used for the same @nonterm{pkg}, then @DFlag{exclude} takes
@ -1121,8 +1125,8 @@ for @nonterm{key}.
]
@history[#:added "6.0.17"
#:changed "7.7.0.1" @elem{Added @DFlag{include}, @DFlag{include-deps}, @DFlag{exclude},
and @DFlag{fast-file-copy}.}]
#:changed "7.7.0.1" @elem{Added @DFlag{include}, @DFlag{include-deps}, @DFlag{include-deps-platform},
@DFlag{exclude}, and @DFlag{fast-file-copy}.}]
}
@subcommand{@command/toc{archive} @nonterm{option} ... @nonterm{dest-dir} @nonterm{pkg} ...

View File

@ -53,6 +53,9 @@
[pattern (#:str name:id default:expr)
#:attr (arg-val 1) (list #'name)
#:attr fun #'identity]
[pattern (#:strs name:id ... default:expr)
#:attr (arg-val 1) (syntax->list #'(name ...))
#:attr fun #'list]
[pattern (#:num name:id default:expr)
#:attr (arg-val 1) (list #'name)
#:attr fun #'(string->num 'name)])

View File

@ -199,6 +199,7 @@
#:quiet? boolean?
#:include (or/c #f (listof string?))
#:include-deps? boolean?
#:include-deps-sys+subpath (or/c #f (cons/c symbol? path-for-some-system?))
#:exclude (or/c #f (listof string?))
#:fast-file-copy? boolean?
#:package-exn-handler (string? exn:fail? . -> . any))

View File

@ -616,6 +616,7 @@
(include-list (cons pkg (or (include-list) '())))]
#:once-each
[#:bool include-deps () "Include dependencies of specified packages"]
[(#:strs sys subpath #f) include-deps-platform () "Include one platform's dependencies"]
#:multi
[(#:str pkg #f) exclude () "Exclude <pkg> from new catalog"
(exclude-list (cons pkg (exclude-list)))]
@ -633,6 +634,9 @@
#:relative-sources? relative
#:include (include-list)
#:include-deps? include-deps
#:include-deps-sys+subpath (and include-deps-platform
(cons (string->symbol (car include-deps-platform))
(string->path (cadr include-deps-platform))))
#:exclude (exclude-list)
#:fast-file-copy? fast-file-copy
#:package-exn-handler (case pkg-fail

View File

@ -11,7 +11,8 @@
"stage.rkt"
"desc.rkt"
"create.rkt"
"path.rkt")
"path.rkt"
"dep.rkt")
(provide pkg-catalog-archive)
@ -19,6 +20,7 @@
src-catalogs
#:include [include-names #f]
#:include-deps? [include-deps? #f]
#:include-deps-sys+subpath [include-deps-sys+subpath #f]
#:exclude [exclude-names '()]
#:from-config? [from-config? #f]
#:state-catalog [state-catalog #f]
@ -45,7 +47,7 @@
(filter-pkgs
(parameterize ([db:current-pkg-catalog-file temp-catalog-file])
(db:get-pkgs))
include-names include-deps?
include-names include-deps? include-deps-sys+subpath
(cons "racket" exclude-names)
temp-catalog-file))
;; Reset state catalog to new packages:
@ -155,7 +157,7 @@
;; ----------------------------------------
(define (filter-pkgs pkgs include-names include-deps? exclude-names catalog)
(define (filter-pkgs pkgs include-names include-deps? include-deps-sys+subpath exclude-names catalog)
(cond
[(not include-names)
(if (null? exclude-names)
@ -181,12 +183,20 @@
(loop (hash-set include-table name #t)
(append
(if include-deps?
(let ([pkg (hash-ref pkg-map name)])
(map car
(parameterize ([db:current-pkg-catalog-file catalog])
(db:get-pkg-dependencies name
(db:pkg-catalog pkg)
(db:pkg-checksum pkg)))))
(let ([pkg (hash-ref pkg-map name #f)])
(cond
[(not pkg)
;; Skip a missing dependency
null]
[else
(for/list ([dep (in-list
(parameterize ([db:current-pkg-catalog-file catalog])
(db:get-pkg-dependencies name
(db:pkg-catalog pkg)
(db:pkg-checksum pkg))))]
#:when (or (not include-deps-sys+subpath)
(dependency-for-platform? dep include-deps-sys+subpath)))
(car dep))]))
null)
(cdr todo-names)))]))])))
(for/list ([pkg (in-list pkgs)]

View File

@ -34,3 +34,7 @@
(define p (dependency-lookup '#:platform dep))
(or (not p) (matching-platform? p #:cross? #t)))
(define (dependency-for-platform? dep sys+subpath)
(define p (dependency-lookup '#:platform dep))
(or (not p) (matching-platform? p #:system-type (car sys+subpath)
#:system-library-subpath (cdr sys+subpath))))