Skip to content

Associate docs from a metapackage to the -lib, -tests etc. sub-packages #75

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 29 additions & 4 deletions src/site.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -597,9 +597,27 @@
(string-append (date->string (seconds->date utc #f) #t) " (UTC)")
"N/A"))

(define (get-implied-docs pkg)
(define (get-implied-docs pkg #:metapackage-implies-index [implies-index #hash()])
;; "foo" is a metapackage for e.g. "foo-lib" or "foo-tests" if foo-lib has a tag
;; "foo", and "foo" implies "foo-lib".
(define metapackage-names
(for*/list ([tag-which-could-be-a-pkg-name (package-tags pkg)]
[tag-implies (in-value (hash-ref implies-index tag-which-could-be-a-pkg-name (λ () #f)))]
#:when tag-implies
#:when (set-member? tag-implies (package-name pkg)))
(string->symbol tag-which-could-be-a-pkg-name)))
(define docs-from-metapackages
(append-map (λ (pkg) (append (package-docs pkg)
;; a metapackage won't have itself a metapackage, so we
;; pass an empty hash to prevent further metapackage lookup.
(get-implied-docs pkg #:metapackage-implies-index #hash())))
(package-batch-detail metapackage-names)))

(define implied-names (map string->symbol (package-implies pkg)))
(append-map package-docs (package-batch-detail implied-names)))
(define docs-from-implied-pkgs (append-map package-docs (package-batch-detail implied-names)))

(append docs-from-metapackages
docs-from-implied-pkgs))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Package hashtable getters.
Expand Down Expand Up @@ -694,10 +712,17 @@
;; representing packages with outstanding build errors or
;; failing tests, or which are missing docs or tags.
(define now (/ (current-inexact-milliseconds) 1000))
(define pkgs-details (package-batch-detail package-names))
(define implies-index
(for/hash ([pkg pkgs-details])
(values (package-name pkg)
(list->set (package-implies pkg)))))
(define-values (pkg-rows num-todos)
(for/fold ([pkg-rows null] [num-todos 0])
([pkg (package-batch-detail package-names)])
(define pkg-docs (append (package-docs pkg) (get-implied-docs pkg)))
([pkg pkgs-details])
(define pkg-docs (remove-duplicates
(append (package-docs pkg)
(get-implied-docs pkg #:metapackage-implies-index implies-index))))
(define has-docs? (pair? pkg-docs))
(define has-readme? (pair? (package-readme-url pkg)))
(define has-tags? (pair? (package-tags pkg)))
Expand Down