Sketch of checking catalog server for package problems

check-pkg.rkt

#lang racket/base

(require (only-in net/url string->url call/input-url get-pure-port)
         (only-in racket/date date-display-format date->string)
         (only-in racket/match match)
         (only-in racket/pretty pretty-print))

(provide packages
         packages-by-author
         package
         report*
         report)

(define catalog-server "https://pkgs.racket-lang.org/pkgs-all")
(define build-server "https://pkg-build.racket-lang.org")

(define current-check-missing-documentation? (make-parameter #f))
(define current-show-non-problem-packages? (make-parameter #f))
(define current-show-full-details? (make-parameter #f))

;; From catalog server get the hash-table, whose keys are package name
;; strings and values are metadata hasheqs.
(define (packages*)
  (define u (string->url catalog-server))
  (call/input-url u get-pure-port read))

;; All packages as a list of their metadata, sorted by name. Note that
;; the name is also available in the metadata under a 'name key, so we
;; need not return the full hash-table with the name keys.
(define (packages)
  (sort (hash-values (packages*))
        string<=?
        #:key (λ (pkg) (hash-ref pkg 'name))
        #:cache-keys? #t))

;; Get a list of metadata for all packages having the given author.
;; Checks both 'author and 'authors.
(define (packages-by-author author)
  (for/list ([ht (in-list (packages))]
             #:when (member author (cons (hash-ref ht 'author #f)
                                         (hash-ref ht 'authors null))))
    ht))

;; Get one specific package's metadata with the given 'name. Returns a
;; list of one item because report* expects a list.
(define (package name)
  (list (hash-ref (packages*) name)))

;; Return a hasheq describing problems about the package. Essentially
;; this reshapes the package's 'build hasheq to a form where it only
;; has mappings that are problems. Also it massages path suffix
;; values, prepending the build server URL, to form a complete, usable
;; URL.
(define (problems pkg)
  (define build (hash-ref pkg 'build (hasheq)))
  (define ht (make-hasheq))
  (define (check k)
    (match (hash-ref build k)
      [#f (void)]
      [(or (? string? v)
           (list "indirect" (and "conflicts.txt" v))) ;?
       (hash-set! ht k (string-append build-server "/" v))]
      [v (eprintf "  WARNING: ignoring unknown value ~v for ~v for package ~v"
                  v k (hash-ref pkg 'name))
         (void)]))
  (check 'conflicts-log)
  (check 'failure-log)
  (check 'test-failure-log)
  (check 'dep-failure-log)
  (when (and (current-check-missing-documentation?)
             (null? (hash-ref build 'docs null)))
    (hash-set! ht 'docs null))
  ht)

;; Produce a hash-table report for the given packages, as well as some
;; stats about the number of packages with errors and the total number
;; of errors among all those packages. For use from Racket programs.
(define (report* pkgs)
  (for*/fold ([num-bad-pkgs 0]
              [num-problems 0]
              [items        (hash)])
             ([pkg   (in-list pkgs)]
              [probs (in-value (problems pkg))]
              #:when (or (current-show-non-problem-packages?)
                         (not (hash-empty? probs))))
    (values
     (add1 num-bad-pkgs)
     (+ num-problems (hash-count probs))
     (hash-set items
               (hash-ref pkg 'name)
               (human-times
                (if (current-show-full-details?)
                    (hash-set pkg 'problems probs)
                    (hasheq 'checksum     (hash-ref pkg 'checksum)
                            'last-updated (hash-ref pkg 'last-updated)
                            'last-checked (hash-ref pkg 'last-checked)
                            'problems     probs)))))))

(define (human-times ht)
  (for/hash ([(k v) (in-hash ht)])
    (values k
            (if (memq k '(last-updated last-checked last-edit))
                (parameterize ([date-display-format 'iso-8601])
                  (date->string (seconds->date v) #t))
                v))))

;; A front end for report* that pretty-prints its reported items and
;; displays other information. For use from CLI.
(define (report pkgs #:exit? [exit? #f])
  (unless (current-check-missing-documentation?)
    (displayln "Not checking for missing documentation."))
  (define-values (num-bad-pkgs num-problems items) (report* pkgs))
  (define summary
    (format "Checked ~a package(s), of which ~a had a total of ~a problem(s)."
            (length pkgs)
            num-bad-pkgs
            num-problems))
  (displayln summary)
  (pretty-print items)
  (displayln summary)
  num-bad-pkgs)

(module+ example-of-packages-for-author
  (report (packages-by-author "[email protected]")))

(module+ example-of-one-package-and-full-verbosity
  (parameterize ([current-check-missing-documentation? #t]
                 [current-show-non-problem-packages? #t]
                 [current-show-full-details? #t])
    (report (package "wffi"))))

(module+ main
  (require racket/cmdline)
  (define author #f)
  (define pkg #f)
  (command-line
   #:once-any
   ["--author" author-email "Check all packages by author" (set! author author-email)]
   ["--package" package-name "Check one specific package" (set! pkg package-name)]
   ["--all" "Check all packages (default)" (void)]
   #:once-each
   ["--no-check-docs" "Ignore missing docs" (current-check-missing-documentation? #f)]
   ["--show-non-problem-pkgs" "Show information about packages without problems" (current-show-non-problem-packages? #t)]
   ["--show-full-details" "Show all details from the catalog about each package" (current-show-full-details? #t)])
  (exit
   (if (zero?
        (report (cond [author (packages-by-author author)]
                      [pkg    (package pkg)]
                      [else   (packages)])))
       0
       1)))