diff --git a/build-racket-package.nix b/build-racket-package.nix index 069a771..e6a4ac5 100644 --- a/build-racket-package.nix +++ b/build-racket-package.nix @@ -12,6 +12,7 @@ "tetheredInstallation" "doMainSetup" "buildDocs" + "gitSubpath" ]; extendDrvArgs = finalAttrs: { @@ -25,6 +26,7 @@ tetheredInstallation ? false, doMainSetup ? tetheredInstallation, buildDocs ? tetheredInstallation, + gitSubpath ? ".", ... } @ attrs: { name = "racket${racket.version}-" + pname + "-" + version; @@ -37,6 +39,7 @@ racketTetheredInstallation = tetheredInstallation; racketDoMainSetup = doMainSetup; racketBuildDocs = buildDocs; + racketGitSubpath = gitSubpath; nativeBuildInputs = [ racket @@ -56,6 +59,15 @@ wrapGApp "$f" fi done - ''; + '' + (lib.optionalString (!tetheredInstallation) '' + find $out/bin -type f -executable -print0 | + while IFS= read -r -d ''' f; do + if test "$(file --brief --mime-type "$f")" = text/x-shellscript; then + substituteInPlace "$f" \ + --replace-fail "\"\''${bindir}/racket\"" \ + "\"\''${bindir}/racket\" --config $out/etc/racket/" + fi + done + ''); }; } diff --git a/overlay.nix b/overlay.nix index 0d9c077..cfb8ecd 100644 --- a/overlay.nix +++ b/overlay.nix @@ -1,74 +1,27 @@ -final: prev: { +final: prev: let + names = builtins.readDir ./racket-catalog |> final.lib.attrNames; + byName = self: + final.lib.map (name: { + inherit name; + value = self.callPackage ./racket-catalog/${name} {}; + }) names |> + final.lib.listToAttrs; +in { racket-minimal = final.callPackage ./racket/minimal.nix {}; racket = final.callPackage ./racket/package.nix {}; + instrumentedFetch = drv: drv.overrideAttrs (afinal: aprev: { + postFetch = (aprev.postFetch or "") + '' + printf "FETCH_HASH:%s:FETCH_HASH" "$(\ + ${final.lib.getExe final.nix} --extra-experimental-features "nix-command" \ + hash path --sri "$out")" + ''; + }); + racketPackages = final.lib.makeScope final.newScope (self: { racketInstallHook = self.callPackage ./racket-install-hook.nix {}; buildRacketPackage = self.callPackage ./build-racket-package.nix {}; makeRacketEnv = self.callPackage ./make-racket-env.nix {}; - - testEnv = self.makeRacketEnv { - packages = [self.ansi-color self.curly-fn-lib]; - }; - - ansi-color = self.callPackage ( - { - lib, - buildRacketPackage, - fetchFromGitHub, - }: buildRacketPackage { - pname = "ansi-color"; - version = "0.2"; - - src = final.fetchFromGitHub { - owner = "renatoathaydes"; - repo = "ansi-color"; - rev = "0.2"; - hash = "sha256-7WDW+4R9K+XLb9nMNGQlU+zAi2Gq7cUqzO3csN+AJvI="; - }; - } - ) {}; - - namespaced-transformer-lib = self.callPackage ( - { - lib, - buildRacketPackage, - fetchFromGitHub, - }: buildRacketPackage { - pname = "namespaced-transformer-lib"; - version = "none"; - - src = "${final.fetchFromGitHub { - owner = "lexi-lambda"; - repo = "namespaced-transformer"; - rev = "4cdc1bdae09a07b78f23665267f2c7df4be5a7f6"; - hash = "sha256-vpDJ7qUNhKreig1LbU33d7TXXHkfd7gPxE1Fc5bvzFE="; - }}/namespaced-transformer-lib"; - } - ) {}; - - curly-fn-lib = self.callPackage ( - { - lib, - buildRacketPackage, - fetchFromGitHub, - - namespaced-transformer-lib, - }: buildRacketPackage { - pname = "curly-fn-lib"; - version = "none"; - - dependencies = [ namespaced-transformer-lib ]; - - src = "${final.fetchFromGitHub { - owner = "lexi-lambda"; - repo = "racket-curly-fn"; - rev = "d64cd71d5b386be85f5979edae6f6b6469a4df86"; - hash = "sha256-ge7o/UAvUXA4DIl03UkqVnLHNaPGq4SqxWvpcKdXndI="; - }}/curly-fn-lib"; - } - ) {}; - - }); + } // (byName self)); } diff --git a/racket-catalog-overrides.rktd b/racket-catalog-overrides.rktd new file mode 100644 index 0000000..d1a3bda --- /dev/null +++ b/racket-catalog-overrides.rktd @@ -0,0 +1 @@ +#hash() diff --git a/racket-install-hook.sh b/racket-install-hook.sh index 4899851..cae27c1 100644 --- a/racket-install-hook.sh +++ b/racket-install-hook.sh @@ -8,6 +8,7 @@ addRacketPath() { racketInstallPhase() { echo "Executing racketInstallPhase" + cd "$racketGitSubpath" runHook preInstall mkdir -p $out/{include,etc/racket,lib/racket,share/racket/pkgs,share/racket/collects,bin,share/applications,share/doc/racket,share/man} diff --git a/racket2nix.rkt b/racket2nix.rkt new file mode 100644 index 0000000..da16522 --- /dev/null +++ b/racket2nix.rkt @@ -0,0 +1,504 @@ +#lang racket/base + +(require + racket/file + racket/function + racket/hash + racket/list + racket/match + racket/port + racket/runtime-path + racket/sandbox + racket/sequence + racket/set + racket/string + + net/url + pkg/lib + setup/getinfo) + +(define main-dist-pkgs + (list->set (installed-pkg-names #:scope 'installation))) + +(define (process-dep dep) + (match dep + [(? string? _) dep] + [(cons "base" _) + "base"] + [(cons name args*) + (let/ec exit + (define args + (for/list ([v (in-slice 2 args*)]) (cons (first v) (second v)))) + (match (assq '#:platform args) + [(cons _ 'windows) (exit #f)] + [(cons _ 'unix) (void)] + [(cons _ plat) (error "unhandled platform" plat)] + [#f (void)]) + (match (assq '#:version args) + [#f (void)] + [(cons _ _) (displayln "WARNING: unhandled version spec")]) + name)])) + +(define (process-deps deps) + (for/list ([dep (in-list deps)] + #:do [(define dep* (process-dep dep))] + #:when dep* + #:unless (set-member? main-dist-pkgs dep*)) + dep*)) + +(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 + (let ([lic-expr (with-input-from-string license read)]) + `(list ,@(cvtl lic-expr))) + (begin + (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)))] + [`(,a OR ,b) + (append (cvtl a) (cvtl b))] + [`(,a AND ,b) + (append (cvtl a) (cvtl b))] + [`(,a WITH ,b) + (error "unhandled with" lic-expr)])) + + +(define (module-name mod-spec) + (match mod-spec + [`(lib ,mod-name) mod-name] + [_ (error "unrecognized module spec" mod-spec)])) + + +(define (extract-path query) + (match (assq 'path query) + [#f #f] + [(cons _ value) value])) + + +;; (list 'github owner repo rev path) +;; (list 'git url rev path) +;; (list 'archive url) +;; - note if the archive contains a single directory inside, that dir is the top level +;; .plt is not supported +(define (normalize-source source checksum) + (define u (string->url source)) + (match (string->url source) + [(or (url "github" _ _ _ _ + (or + (list + (path/param owner '()) + (path/param repo '())) + (list + (path/param owner '()) + (path/param repo '()) + ; there might be a branch/tag -- ignore it and use "checksum" as rev + _)) + (app extract-path path-maybe) + _) + (url (pregexp #px"^git|(git\\+)?https?$") _ "github.com" _ _ + (list + (path/param owner '()) + (path/param (pregexp #px"^(.*?)(\\.git)?$" (list _ repo _)) '())) + (app extract-path path-maybe) + _)) + (list + 'github + owner + repo + checksum + path-maybe)] + + [(or (url "github" _ _ _ _ _ _ _) + (url (pregexp #px"^git|(git\\+)?https?$") _ "github.com" _ _ _ _ _)) + (error "invalid github url" source)] + + [(or (url (or "git" "git+http" "git+https") _ _ _ _ _ + (app extract-path path-maybe) + _) + (url (or "http" "https") _ _ _ _ + (or + (list _ ... (path/param (pregexp #px"\\.git$") '())) + (list _ ... (path/param (pregexp #px"\\.git$") '()) (path/param "" '()))) + (app extract-path path-maybe) + _)) + (define u* + (url + (url-scheme u) + (url-user u) + (url-host u) + (url-port u) + (url-path-absolute? u) + (url-path u) + '() + #f)) + (list 'git (url->string u*) checksum path-maybe)] + + [(url (or "http" "https") _ _ _ _ + (list _ ... (path/param (pregexp #px"\\.(zip|tar|tgz|tar\\.gz)$") '())) + _ _) + (list 'archive source)] + + [_ (error "unrecognized source url" source)])) + + +(define (extract-free-vars expr [scope (set)]) + (match expr + [`(dot ,a ,(? symbol? b)) + (extract-free-vars a)] + [`(app ,fun ,arg) + (append (extract-free-vars fun scope) + (extract-free-vars arg scope))] + [`(attrs (,names ,values) ...) + (for/fold ([acc '()]) ([name (in-list names)] [value (in-list values)]) + (append acc (extract-free-vars value scope)))] + [`(templatestring ,exprs ...) + (for/fold ([acc '()]) ([expr (in-list exprs)]) + (append acc (extract-free-vars expr scope)))] + [`(list ,exprs ...) + (for/fold ([acc '()]) ([expr (in-list exprs)]) + (append acc (extract-free-vars expr scope)))] + [(? symbol? _) + (if (set-member? scope expr) + '() + (list expr))] + [(? string? _) '()] + [(? boolean? _) '()] + [(? number? _) '()])) + + +(define (callpackageify expr) + (define free-vars (set->list (list->set (extract-free-vars expr)))) + `(function + ,free-vars + ,expr)) + + +(define (render-nix expr) + (match expr + [(or (? number? _) + (? symbol? _) + (? string? _)) + (write expr)] + [(? boolean? _) + (write-string (if expr "true" "false"))] + [`(function ,vars ,expr) + (write-string "{\n") + (for ([var (in-list vars)]) + (write var) + (write-string ",\n")) + (write-string "}:\n") + (render-nix expr)] + [`(app ,fun ,arg) + (write-string "(") + (render-nix fun) + (write-string " ") + (render-nix arg) + (write-string ")")] + [`(list ,exprs ...) + (write-string "[") + (for ([expr (in-list exprs)]) + (write-string "(") + (render-nix expr) + (write-string ") ")) + (write-string "]")] + [`(dot ,a ,b) + (write-string "(") + (render-nix a) + (write-string ").") + (render-nix b)] + [`(templatestring ,exprs ...) + (write-string "\"") + (for ([expr (in-list exprs)]) + (if (string? expr) + (write-string expr) + (begin + (write-string "${") + (render-nix expr) + (write-string "}")))) + (write-string "\"")] + [`(attrs (,names ,values) ...) + (write-string "{\n") + (for ([name (in-list names)] [value (in-list values)]) + (write name) + (write-string " = ") + (render-nix value) + (write-string ";\n")) + (write-string "}")]) + (void)) + +(struct nix-repl [proc stdout stdin]) + +(define current-nix-repl (make-parameter #f)) + +(define (with-nix-repl 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" ".")) + + (sync (regexp-match-evt #px"^[^\x05]+\x05" stdout)) + + (parameterize ([current-nix-repl (nix-repl proc stdout stdin)]) + (thk)))))) + +(define (nix-eval line) + (match-define (nix-repl _ stdout stdin) (current-nix-repl)) + (write-string line stdin) + (newline stdin) + (flush-output stdin) + + (string-trim + (bytes->string/utf-8 + (second + (sync (regexp-match-evt #px"^([^\x05]+)\x05" stdout)))))) + + +(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))) + +(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")) + (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)))))) + +(define (racket2nix + pkg-name + [force? #f] + [base-dir (build-path "racket-catalog")] + [acc (make-hash)]) + (define pkg-dir (build-path base-dir pkg-name)) + (when + (match (hash-ref acc pkg-name #f) + ['pending (error "circular dependency!" pkg-name)] + ['installed #f] + [#f (or (not (directory-exists? pkg-dir)) + force?)]) + + (hash-set! acc pkg-name 'pending) + (printf "fetching info for ~a\n" pkg-name) + (define details* (get-pkg-details-from-catalogs pkg-name)) + + (define details + (if (hash-has-key? catalog-overrides pkg-name) + (hash-union + details* + (hash-ref catalog-overrides pkg-name) + #:combine/key (lambda (k v0 v) v)) + details*)) + + (define description (hash-ref details 'description)) + + (define license (hash-ref details 'license)) + (define nix-license (racket-license->nix-license license)) + + (define dependencies (process-deps (hash-ref details 'dependencies))) + (define nix-deps + `(list ,@(map string->symbol dependencies))) + + (for ([dependency (in-list dependencies)]) + (racket2nix dependency force? base-dir acc)) + + (define broken? (not (hash-ref (hash-ref details 'search-terms) ':build-success:))) + + (define source (hash-ref details 'source)) + (define checksum (hash-ref details 'checksum)) + (define git-shorthash (substring checksum 0 7)) + (define source-desc (normalize-source source checksum)) + + (define readme (hash-ref details 'readme-url)) + + (define modules* (hash-ref details 'modules)) + (define modules (map module-name modules*)) + + (make-directory* pkg-dir) + + (define (generate-spec + [nix-hash '(dot lib fakeHash)] + [version "0.0"] + [racket-launchers '()] + [raco-commands '()] + [format? #f]) + (define-values (nix-src* subpath) + (match source-desc + [(list 'github owner repo rev path) + (values + `((src + (app + fetchFromGitHub + (attrs + (owner ,owner) + (repo ,repo) + (rev ,rev) + (hash ,nix-hash)))) + (gitSubpath ,(or path "."))) + (or path 'same))] + [(list 'git url rev path) + (values + `((src + (app + fetchgit + (attrs + (url ,url) + (rev ,rev) + (hash ,nix-hash)))) + (gitSubpath ,(or path "."))) + (or path 'same))] + [(list 'archive url) + (values + `(app + fetchzip + (attrs + (url ,url) + (hash ,nix-hash))) + 'same)])) + + (define nix-version (format "~a+~a" version git-shorthash)) + + (define nix-meta + `(attrs + (description ,description) + (sourceProvenance (list (dot (dot lib sourceTypes) fromSource))) + (broken ,broken?) + (license ,nix-license) + ,@(if readme `((homepage ,readme)) '()) + ,@(if (and racket-launchers (not (empty? racket-launchers))) + `((mainProgram ,(first racket-launchers))) + '()) + )) + + (define nix-passthru + `(attrs + (racketModules (list ,@modules)) + (racketLaunchers (list ,@racket-launchers)) + (racoCommands (list ,@raco-commands)))) + + (define nix-spec* + `(app + buildRacketPackage + (attrs + (pname ,pkg-name) + (version ,nix-version) + (dependencies ,nix-deps) + ,@nix-src* + (passthru ,nix-passthru) + (meta ,nix-meta)))) + + (define nix-spec (callpackageify nix-spec*)) + + (define default-nix (build-path pkg-dir "default.nix")) + + (with-output-to-file default-nix + (lambda () + (render-nix nix-spec)) + #:exists 'replace) + + (when format? + (nix-format default-nix)) + + (add-to-git-maybe default-nix) + + subpath) + + (generate-spec) + + (displayln "fetching source") + + (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 build-log (nix-eval ":log drv")) + (match-define (list _ real-hash) + (regexp-match #px"FETCH_HASH:([^:]+):FETCH_HASH" 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 out-path (nix-eval ":p drv.outPath")) + (nix-eval ":b drv") + + (define info-proc (get-info/full (build-path out-path subpath))) + + (define version (info-proc 'version (lambda () "0.0"))) + (define racket-launchers (info-proc 'racket-launcher-names (lambda () '()))) + (define raco-commands* (info-proc 'raco-commands (lambda () '()))) + (define raco-commands + (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)))) + + (hash-set! acc pkg-name 'installed) + + (void)))