<commit_before>#lang at-exp racket/base
(require racket/format
         racket/file
         scribble/html
         (only-in plt-web site page call-with-registered-roots))

(provide summary-page
         (struct-out doc/main)
         (struct-out doc/extract)
         (struct-out doc/salvage)
         (struct-out doc/none)
         (struct-out conflicts/indirect))

(struct doc/main (name path) #:prefab)
(struct doc/extract (name path) #:prefab)
(struct doc/salvage (name path) #:prefab)
(struct doc/none (name) #:prefab)

(struct conflicts/indirect (path) #:prefab)

(define (summary-page summary-ht dest-dir)
  (define page-site (site "pkg-build"
                          #:url "http://pkg-build.racket-lang.org/"
                          #:share-from (site "www"
                                             #:url "http://racket-lang.org/"
                                             #:generate? #f)))

  (define page-title "Package Build Results")

  (define summary
    (for/list ([pkg (in-list (sort (hash-keys summary-ht) string<?))])
      (define ht (hash-ref summary-ht pkg))
      (define failed? (and (hash-ref ht 'failure-log) #t))
      (define succeeded? (and (hash-ref ht 'success-log) #t))
      (define status
        (cond
         [(and failed? (not succeeded?)) 'failure]
         [(and succeeded? (not failed?)) 'success]
         [(and succeeded? failed?) 'confusion]
         [else 'unknown]))
      (define dep-status
        (if (eq? status 'success)
            (if (hash-ref ht 'dep-failure-log)
                'failure
                'success)
            'unknown))
      (define docs (hash-ref ht 'docs))
      (define author (hash-ref ht 'author))
      (define conflicts-log (hash-ref ht 'conflicts-log))
      (tr (td pkg)
          (td author)
          (td (if (null? docs)
                  ""
                  (list
                   "Docs: "
                   (add-between
                    (for/list ([doc (in-list docs)])
                      (cond
                       [(doc/main? doc)
                        (a href: (doc/main-path doc)
                           (doc/main-name doc))]
                       [(doc/extract? doc)
                        (a href: (doc/extract-path doc)
                           (doc/extract-name doc))]
                       [(doc/salvage? doc)
                        (list (a href: (doc/salvage-path doc)
                                 (doc/salvage-name doc))
                              (span class: "annotation"
                                    nbsp
                                    "(salvaged)"))]
                       [(doc/none? doc)
                        (doc/none-name doc)]
                       [else "???"]))
                    ", "))))
          (td class: (case status
                       [(failure confusion) "stop"]
                       [(success)
                        (case dep-status
                          [(failure) "yield"]
                          [else "go"])]
                       [else "unknown"])
              (case status
                [(failure)
                 (a href: (hash-ref ht 'failure-log)
                    "install fails")]
                [(success)
                 (list
                  (a href: (hash-ref ht 'success-log)
                     "install succeeds")
                  (case dep-status
                    [(failure)
                     (list
                      " with "
                      (a href: (hash-ref ht 'dep-failure-log)
                         "dependency problems"))]))]
                [(confusion)
                 (list
                  "install both "
                  (a href: (hash-ref ht 'success-log)
                     "succeeds")
                  " and "
                  (a href: (hash-ref ht 'failure-log) "fails"))]
                [else ""]))
          (td class: (if conflicts-log "stop" "neutral")
              (if conflicts-log
                  (a href: (if (conflicts/indirect? conflicts-log)
                               (conflicts/indirect-path conflicts-log)
                               conflicts-log)
                     (if (conflicts/indirect? conflicts-log)
                         "conflicts in dependency"
                         "conflicts"))
                  "")))))

  (define page-headers
    (style/inline @~a|{
                    .go { background-color: #ccffcc }
                    .stop { background-color: #ffcccc }
                    .yield { background-color: #ffffcc }
                    .annotation { font-size: small }
                  }|))

  (void (page #:site page-site
              #:file "index.html"
              #:title page-title
              (html (head (title page-title)
                          page-headers)
                    (body (table summary)))))

  ;; Render to "pkg-build", then move up:
  (call-with-registered-roots
   (lambda ()
     (parameterize ([current-directory dest-dir])
       (render-all))))

  (define sub-dir (build-path dest-dir "pkg-build"))
  (for ([f (in-list (directory-list sub-dir))])
    (delete-directory/files f #:must-exist? #f)
    (rename-file-or-directory (build-path sub-dir f) f))
  (delete-directory sub-dir))
<commit_msg>pkg-build: tweak format of summary page<commit_after>#lang at-exp racket/base
(require racket/format
         racket/file
         scribble/html
         (only-in plt-web site page call-with-registered-roots))

(provide summary-page
         (struct-out doc/main)
         (struct-out doc/extract)
         (struct-out doc/salvage)
         (struct-out doc/none)
         (struct-out conflicts/indirect))

(struct doc/main (name path) #:prefab)
(struct doc/extract (name path) #:prefab)
(struct doc/salvage (name path) #:prefab)
(struct doc/none (name) #:prefab)

(struct conflicts/indirect (path) #:prefab)

(define (summary-page summary-ht dest-dir)
  (define page-site (site "pkg-build"
                          #:url "http://pkg-build.racket-lang.org/"
                          #:share-from (site "www"
                                             #:url "http://racket-lang.org/"
                                             #:generate? #f)))

  (define page-title "Package Build Results")

  (define summary
    (for/list ([pkg (in-list (sort (hash-keys summary-ht) string<?))])
      (define ht (hash-ref summary-ht pkg))
      (define failed? (and (hash-ref ht 'failure-log) #t))
      (define succeeded? (and (hash-ref ht 'success-log) #t))
      (define status
        (cond
         [(and failed? (not succeeded?)) 'failure]
         [(and succeeded? (not failed?)) 'success]
         [(and succeeded? failed?) 'confusion]
         [else 'unknown]))
      (define dep-status
        (if (eq? status 'success)
            (if (hash-ref ht 'dep-failure-log)
                'failure
                'success)
            'unknown))
      (define docs (hash-ref ht 'docs))
      (define author (hash-ref ht 'author))
      (define conflicts-log (hash-ref ht 'conflicts-log))
      (tr (td pkg
              (div class: "author" author))
          (td (if (null? docs)
                  ""
                  (list
                   "Docs: "
                   (add-between
                    (for/list ([doc (in-list docs)])
                      (cond
                       [(doc/main? doc)
                        (a href: (doc/main-path doc)
                           (doc/main-name doc))]
                       [(doc/extract? doc)
                        (a href: (doc/extract-path doc)
                           (doc/extract-name doc))]
                       [(doc/salvage? doc)
                        (list (a href: (doc/salvage-path doc)
                                 (doc/salvage-name doc))
                              (span class: "annotation"
                                    nbsp
                                    "(salvaged)"))]
                       [(doc/none? doc)
                        (doc/none-name doc)]
                       [else "???"]))
                    ", "))))
          (td class: (case status
                       [(failure confusion) "stop"]
                       [(success)
                        (case dep-status
                          [(failure) "yield"]
                          [else "go"])]
                       [else "unknown"])
              (case status
                [(failure)
                 (a href: (hash-ref ht 'failure-log)
                    "install fails")]
                [(success)
                 (list
                  (a href: (hash-ref ht 'success-log)
                     "install succeeds")
                  (case dep-status
                    [(failure)
                     (list
                      " with "
                      (a href: (hash-ref ht 'dep-failure-log)
                         "dependency problems"))]))]
                [(confusion)
                 (list
                  "install both "
                  (a href: (hash-ref ht 'success-log)
                     "succeeds")
                  " and "
                  (a href: (hash-ref ht 'failure-log) "fails"))]
                [else ""]))
          (td class: (if conflicts-log "stop" "neutral")
              (if conflicts-log
                  (a href: (if (conflicts/indirect? conflicts-log)
                               (conflicts/indirect-path conflicts-log)
                               conflicts-log)
                     (if (conflicts/indirect? conflicts-log)
                         "conflicts in dependency"
                         "conflicts"))
                  "")))))

  (define page-headers
    (style/inline @~a|{
                    .go { background-color: #ccffcc }
                    .stop { background-color: #ffcccc }
                    .yield { background-color: #ffffcc }
                    .author { font-size: small; font-weight: normal; }
                    .annotation { font-size: small }
                  }|))

  (void (page #:site page-site
              #:file "index.html"
              #:title page-title
              (html (head (title page-title)
                          page-headers)
                    (body (table summary)))))

  ;; Render to "pkg-build", then move up:
  (call-with-registered-roots
   (lambda ()
     (parameterize ([current-directory dest-dir])
       (render-all))))

  (define sub-dir (build-path dest-dir "pkg-build"))
  (for ([f (in-list (directory-list sub-dir))])
    (delete-directory/files f #:must-exist? #f)
    (rename-file-or-directory (build-path sub-dir f) f))
  (delete-directory sub-dir))

{'fraction_non_alphanumeric': 0.1260361718161266, 'fraction_numerical': 0.0, 'mean_word_length': 1.143549364021805, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 14, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3860628', 'n_tokens_mistral': 2985, 'n_tokens_neox': 2770, 'n_words': 710}