diff --git a/racket2nix.rkt b/racket2nix.rkt index da16522..e036573 100644 --- a/racket2nix.rkt +++ b/racket2nix.rkt @@ -49,13 +49,6 @@ (define-runtime-path overrides-path "racket-catalog-overrides.rktd") (define catalog-overrides (file->value overrides-path)) -(define *license-mapping* - (hash - 'BSD-3-Clause '(dot (dot lib licenses) bsd3) - 'MIT '(dot (dot lib licenses) mit) - 'Apache-2.0 '(dot (dot lib licenses) asl20) - 'LGPL-3.0-or-later '(dot (dot lib licenses) lgpl3Plus) - 'Unicode-TOU '(dot (dot lib licenses) unicodeTOU))) (define (racket-license->nix-license license) (if license @@ -65,13 +58,11 @@ (displayln "WARNING: no license for package -- using unfree") '(dot (dot lib licenses) unfree)))) + (define (cvtl lic-expr) (match lic-expr [(? symbol? _) - (list - (or - (hash-ref *license-mapping* lic-expr #f) - (error "no license mapping defined for" lic-expr)))] + (list `(dot (dot lib licensesSpdx) ,(symbol->string lic-expr)))] [`(,a OR ,b) (append (cvtl a) (cvtl b))] [`(,a AND ,b) @@ -160,7 +151,7 @@ (define (extract-free-vars expr [scope (set)]) (match expr - [`(dot ,a ,(? symbol? b)) + [`(dot ,a ,(or (? symbol? b) (? string? b))) (extract-free-vars a)] [`(app ,fun ,arg) (append (extract-free-vars fun scope) @@ -243,31 +234,40 @@ (write-string "}")]) (void)) -(struct nix-repl [proc stdout stdin]) -(define current-nix-repl (make-parameter #f)) - -(define (with-nix-repl thk) +(define (call-with-subprocess-env thk) (parameterize ([current-subprocess-custodian-mode 'kill] [current-environment-variables (environment-variables-copy (current-environment-variables))]) (putenv "TERM" "dumb") (putenv "NO_COLOR" "1") (call-with-custodian-shutdown - (lambda () - (define-values (proc stdout stdin stderr) - (subprocess - #f #f 'stdout - "/usr/bin/env" - "nix" - "--extra-experimental-features" - "nix-command flakes pipe-operator repl-automation" - "repl" "--impure" ".")) + thk))) + +(define (subprocess/path/piped . args) + (define-values [proc stdout stdin stderr] + (apply subprocess #f #f 'stdout "/usr/bin/env" args)) + (values proc stdout stdin)) + + +(struct nix-repl [proc stdout stdin]) +(define current-nix-repl (make-parameter #f)) + + +(define (call-with-nix-repl thk) + (call-with-subprocess-env + (lambda () + (define-values [proc stdout stdin] + (subprocess/path/piped + "nix" + "--extra-experimental-features" + "nix-command flakes pipe-operator repl-automation" + "repl" "--impure" ".")) (sync (regexp-match-evt #px"^[^\x05]+\x05" stdout)) (parameterize ([current-nix-repl (nix-repl proc stdout stdin)]) - (thk)))))) + (thk))))) (define (nix-eval line) (match-define (nix-repl _ stdout stdin) (current-nix-repl)) @@ -284,46 +284,33 @@ (define (nix-format file*) (displayln "formatting generated nix") (define file (path->string file*)) - (parameterize ([current-subprocess-custodian-mode 'kill] - [current-environment-variables - (environment-variables-copy (current-environment-variables))]) - (putenv "TERM" "dumb") - (putenv "NO_COLOR" "1") - (call-with-custodian-shutdown - (lambda () - (define-values (proc stdout stdin stderr) - (subprocess - #f #f 'stdout - "/usr/bin/env" - "alejandra" - "--quiet" - file)) - (port->string stdout) - (subprocess-wait proc))) - (void))) + (call-with-subprocess-env + (lambda () + (define-values [proc stdout stdin] + (subprocess/path/piped + "alejandra" "--quiet" file)) + (port->string stdout) + (subprocess-wait proc))) + (void)) + (define (add-to-git-maybe file*) (define file (path->string file*)) - (parameterize ([current-subprocess-custodian-mode 'kill]) - (call-with-custodian-shutdown - (lambda () - (define-values (proc stdout stdin stderr) - (subprocess - #f #f 'stdout - "/usr/bin/env" - "git" - "rev-parse" - "--show-toplevel")) + (call-with-subprocess-env + (lambda () + (define-values (proc stdout stdin) + (subprocess/path/piped + "git" "rev-parse" "--show-toplevel")) + (port->string stdout) + (subprocess-wait proc) + + (when (= 0 (subprocess-status proc)) + (define-values [proc stdout stdin] + (subprocess/path/piped + "git" "add" file)) (port->string stdout) - (subprocess-wait proc) - (when (= 0 (subprocess-status proc)) - (define-values (proc stdout stdin stderr) - (subprocess - #f #f 'stdout - "/usr/bin/env" - "git" "add" file)) - (port->string stdout) - (subprocess-wait proc)))))) + (subprocess-wait proc))))) + (define (racket2nix pkg-name @@ -427,8 +414,7 @@ ,@(if readme `((homepage ,readme)) '()) ,@(if (and racket-launchers (not (empty? racket-launchers))) `((mainProgram ,(first racket-launchers))) - '()) - )) + '()))) (define nix-passthru `(attrs @@ -467,20 +453,38 @@ (displayln "fetching source") - (with-nix-repl + (call-with-nix-repl (lambda () - (define drv-def-out (nix-eval - (format "drv = with legacyPackages.${builtins.currentSystem}; instrumentedFetch (racketPackages.~a.src)" pkg-name))) - (nix-eval ":b drv") + (define drv-def-out + (nix-eval + (format "drv = with legacyPackages.${builtins.currentSystem}; instrumentedFetch (racketPackages.~a.src)" pkg-name))) + + (unless (equal? drv-def-out "Added drv.") + (error "failed to eval package def" drv-def-out)) + + (define build-output (nix-eval ":b drv")) (define build-log (nix-eval ":log drv")) - (match-define (list _ real-hash) - (regexp-match #px"FETCH_HASH:([^:]+):FETCH_HASH" build-log)) + (define real-hash + (match build-log + [(pregexp #px"FETCH_HASH:([^:]+):FETCH_HASH" (list _ real-hash)) + real-hash] + [_ (error "failed to retrieve src hash" build-output build-log)])) + (define subpath (generate-spec real-hash)) + (nix-eval ":r") - (nix-eval - (format "drv = with legacyPackages.${builtins.currentSystem}; instrumentedFetch (racketPackages.~a.src)" pkg-name)) + (define drv-def-out-r + (nix-eval + (format "drv = with legacyPackages.${builtins.currentSystem}; instrumentedFetch (racketPackages.~a.src)" pkg-name))) + + (unless (equal? drv-def-out-r "Added drv.") + (error "failed to eval package def" drv-def-out-r)) + (define out-path (nix-eval ":p drv.outPath")) - (nix-eval ":b drv") + (define build-log-2 (nix-eval ":b drv")) + + (unless (directory-exists? out-path) + (error "failed to fetch source" out-path build-log-2)) (define info-proc (get-info/full (build-path out-path subpath))) @@ -491,13 +495,23 @@ (and raco-commands* (map first raco-commands*))) - ; generate final nix file (generate-spec real-hash version racket-launchers raco-commands #t) (displayln "doing final module build") (nix-eval ":r") - (nix-eval - (format ":b with legacyPackages.${builtins.currentSystem}; racketPackages.~a" pkg-name)))) + (define drv-def-out-final + (nix-eval + (format "drv = with legacyPackages.${builtins.currentSystem}; racketPackages.~a" pkg-name))) + (unless (equal? drv-def-out-final "Added drv.") + (error "failed to eval package def" drv-def-out-final)) + (define out-path-final (nix-eval ":p drv.outPath")) + (define build-output-final + (nix-eval ":b drv")) + + (unless (directory-exists? out-path-final) + (error "failed to do final build" out-path-final build-output-final)) + + (void))) (hash-set! acc pkg-name 'installed)