assemble-site.rkt (5048B)
1 #lang racket/base 2 (require racket/cmdline 3 racket/file 4 net/url 5 "download-page.rkt" 6 "indexes.rkt" 7 (only-in distro-build/config extract-options) 8 (only-in plt-web site)) 9 10 (module test racket/base) 11 12 (define build-dir (build-path "build")) 13 14 (define built-dir (build-path build-dir "built")) 15 (define native-dir (build-path build-dir "native")) 16 (define docs-dir (build-path build-dir "docs")) 17 18 (define installers-dir (build-path "installers")) 19 (define pkgs-dir (build-path "pkgs")) 20 (define catalog-dir (build-path "catalog")) 21 (define from-catalog-dir-to-pkgs-dir (build-path 'up)) 22 (define doc-dir (build-path "doc")) 23 (define pdf-doc-dir (build-path "pdf-doc")) 24 (define log-dir (build-path "log")) 25 26 (define-values (config-file config-mode) 27 (command-line 28 #:args 29 (config-file config-mode) 30 (values config-file config-mode))) 31 32 (define config (extract-options config-file config-mode)) 33 34 (define dest-dir (hash-ref config 35 '#:site-dest 36 (build-path build-dir "site"))) 37 38 (define site-title (hash-ref config 39 '#:site-title 40 "Racket Downloads")) 41 42 (define www-site (and (hash-ref config '#:plt-web-style? #t) 43 (site "www" 44 #:url "https://racket-lang.org/" 45 #:generate? #f))) 46 47 (printf "Assembling site as ~a\n" dest-dir) 48 49 (define (copy dir [build-dir build-dir]) 50 (make-directory* (let-values ([(base name dir?) (split-path dir)]) 51 (if (path? base) 52 (build-path dest-dir base) 53 dest-dir))) 54 (printf "Copying ~a\n" (build-path build-dir dir)) 55 (copy-directory/files (build-path build-dir dir) 56 (build-path dest-dir dir) 57 #:keep-modify-seconds? #t)) 58 59 (delete-directory/files dest-dir #:must-exist? #f) 60 61 (define (build-catalog built-dir) 62 (printf "Building catalog from ~a\n" built-dir) 63 (let ([c-dir (build-path built-dir pkgs-dir)] 64 [d-dir (build-path dest-dir pkgs-dir)]) 65 (make-directory* d-dir) 66 (for ([f (directory-list c-dir)]) 67 (define c (build-path c-dir f)) 68 (define d (build-path d-dir f)) 69 (copy-file c d) 70 (file-or-directory-modify-seconds d (file-or-directory-modify-seconds c)))) 71 (let ([c-dir (build-path built-dir catalog-dir "pkg")] 72 [d-dir (build-path dest-dir catalog-dir "pkg")]) 73 (make-directory* d-dir) 74 (for ([f (in-list (directory-list c-dir))]) 75 (define ht (call-with-input-file* (build-path c-dir f) read)) 76 (define new-ht 77 (hash-set ht 'source (relative-path->relative-url-string 78 (build-path 79 from-catalog-dir-to-pkgs-dir 80 pkgs-dir 81 (path-add-suffix f #".zip"))))) 82 (call-with-output-file* 83 (build-path d-dir f) 84 (lambda (o) 85 (write new-ht o) 86 (newline o)))))) 87 88 (build-catalog built-dir) 89 (when (directory-exists? native-dir) 90 (build-catalog native-dir)) 91 (let ([l (directory-list (build-path dest-dir catalog-dir "pkg"))]) 92 ;; Write list of packages: 93 (define sl (map path-element->string l)) 94 (call-with-output-file* 95 (build-path dest-dir catalog-dir "pkgs") 96 (lambda (o) 97 (write sl o) 98 (newline o))) 99 ;; Write hash table of package details: 100 (define dht 101 (for/hash ([f (in-list l)]) 102 (values (path-element->string f) 103 (call-with-input-file* 104 (build-path dest-dir catalog-dir "pkg" f) 105 read)))) 106 (call-with-output-file* 107 (build-path dest-dir catalog-dir "pkgs-all") 108 (lambda (o) 109 (write dht o) 110 (newline o)))) 111 112 (copy log-dir) 113 (generate-index-html dest-dir log-dir www-site) 114 115 (copy installers-dir) 116 (generate-index-html dest-dir installers-dir www-site) 117 118 (define doc-path (build-path docs-dir doc-dir)) 119 (when (directory-exists? doc-path) 120 (copy doc-dir docs-dir)) 121 (define pdf-doc-path (build-path build-dir pdf-doc-dir)) 122 (when (directory-exists? pdf-doc-path) 123 (copy pdf-doc-dir) 124 (generate-index-html dest-dir pdf-doc-dir www-site)) 125 (copy "stamp.txt") 126 (copy (build-path "origin" "collects.tgz")) 127 128 (make-download-page (build-path build-dir 129 installers-dir 130 "table.rktd") 131 #:plt-www-site www-site 132 #:title site-title 133 #:installers-url "installers/" 134 #:log-dir-url "log/" 135 #:docs-url (and (directory-exists? doc-path) 136 "doc/index.html") 137 #:pdf-docs-url (and (directory-exists? pdf-doc-path) 138 "pdf-doc/") 139 #:dest (build-path dest-dir 140 "index.html") 141 #:help-table (hash-ref config '#:site-help (hash)) 142 #:git-clone (current-directory))