From 80883d3206562afc9b170fda7c4271f0509f5ea5 Mon Sep 17 00:00:00 2001
From: Puck Meerburg <puck@puckipedia.com>
Date: Tue, 29 Apr 2025 15:04:43 +0000
Subject: [PATCH] (zilch core nixpkgs): add "eval raw in nixpkgs" function

This allows evaluating code that isn't as obviously "one derivation";
e.g. `pkgs.mkShell'.
---
 core/src/nixpkgs.sld | 80 +++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 76 insertions(+), 4 deletions(-)

diff --git a/core/src/nixpkgs.sld b/core/src/nixpkgs.sld
index 5739f59..fc14c49 100644
--- a/core/src/nixpkgs.sld
+++ b/core/src/nixpkgs.sld
@@ -1,12 +1,13 @@
 (define-library (zilch nixpkgs)
   (import
-    (scheme base) (scheme lazy)
+    (scheme base) (scheme lazy) (scheme read)
     (zilch magic) (zilch nix drv) (zilch nix hash)
-    (zilch zexpr)
+    (zilch nix path) (zilch zexpr)
     (srfi 18) (srfi 128) (srfi 146)
     (chicken format) (chicken process)
     json)
-  (export nix-prefetch-url nixpkgs nix-eval)
+  (export nix-prefetch-url nixpkgs nixpkgs-eval
+    nix-eval environment-for-derivation)
 
   (begin
     (define (run-stderr-thread prefix port)
@@ -26,6 +27,15 @@
       (close-port stdout)
       drvpath)
 
+    (define (read-from-nixpkgs-raw path)
+      (define-values (stdout stdin pid stderr) (process* "nix-instantiate" `("-E" ,(string-append "with import <nixpkgs> {}; (" path ")"))))
+      (define thread (thread-start! (make-thread (lambda () (run-stderr-thread (string-append path) stderr)) "read-from-nixpkgs-raw stderr passthrough")))
+      (close-port stdin)
+      (define drvpath (read-line stdout))
+      (define-values (_ _ _) (process-wait pid #t))
+      (close-port stdout)
+      drvpath)
+
     (define (read-from-eval code)
       (define-values (stdout stdin pid stderr) (process* "nix-instantiate" `("--json" "--eval" "--strict" "--read-write-mode" "-E" ,code)))
       (define thread (thread-start! (make-thread (lambda () (run-stderr-thread (string-append "eval `" code "`") stderr)) "read-from-eval stderr passthrough")))
@@ -58,6 +68,17 @@
             (set! eval-cache (cons (cons path data) eval-cache))
             data)))
 
+    (define raw-eval-cache '())
+    (define (nixpkgs-eval path)
+      (define val (assoc path raw-eval-cache))
+      (if (not (eq? val #f))
+          (cdr val)
+          (let* ((drv-path (read-from-nixpkgs-raw path))
+                 (drv (read-drv-path drv-path))
+                 (data (map (lambda (l) (cons (car l) (make-store-path drv (car l) #t))) (derivation-outputs drv))))
+            (set! raw-eval-cache (cons (cons path data) raw-eval-cache))
+            data)))
+
     (define (nix-eval-inner code)
       (define response (read-from-eval (string-append "(v: [(builtins.getContext (builtins.toJSON v)) v]) (" code ")")))
       ; Format: key is drv,
@@ -84,4 +105,55 @@
     (define (nix-eval code)
       (define data (delay (nix-eval-inner code)))
       (make-zexp (lambda () (let-values (((drvs paths out) (force data))) (zexp-context-register-items drvs paths) out))
-                 (lambda (p) (fprintf p "nix`~A`" code))))))
+                 (lambda (p) (fprintf p "nix`~A`" code))))
+
+    (define (environment-for-derivation drv)
+      (when (store-path? drv) (set! drv (store-path-drv drv)))
+      (define processor
+       (string-append "if [ -e \"$NIX_ATTRS_SH_FILE\" ]; then source \"$NIX_ATTRS_SH_FILE\"; fi
+                  export IN_NIX_SHELL=impure; export dontAddDisableDepTrack=1
+                  if [[ -n $stdenv ]]; then
+                    source $stdenv/setup
+                  fi
+                  __printString() {
+                    local str=\"$1\"
+                    str=\"${str//\\\\/\\\\\\\\}\"
+                    str=\"${str//\\\"/\\\\\\\"}\"
+                    str=\"${str//$'\\n'/\\\\n}\"
+                    str=\"${str//$'\\r'/\\\\r}\"
+                    printf '\"%s\"' \"$str\"
+                  }
+                  out=" (make-placeholder "out") "
+                  printf '(' > $out
+                  __run() {
+                    declare -p | while read __line; do
+                      if ! [[ $__line =~ ^declare\\ (-[^ ])\\ ([^=]*) ]]; then continue; fi
+                      local __varname=\"${BASH_REMATCH[2]}\"
+                      if [[ \"${BASH_REMATCH[1]}\" == -x ]]; then
+                        printf '('
+                        __printString \"$__varname\"
+                        printf '.'
+                        __printString \"${!__varname}\"
+                        printf ')'
+                      fi
+                    done
+                  }
+                  __run >> $out
+                  printf ')' >> $out\n"))
+      (define new-env (list))
+      (for-each
+        (lambda (kv)
+          (unless (member (car kv) '("out" "name" "builder" "system") string=?) (set! new-env (cons kv new-env))))
+        (derivation-env drv))
+      (define is-ca-derivation (symbol? (derivation-output-hash (cdar (derivation-outputs drv)))))
+      (define out-drv
+       ((if is-ca-derivation make-ca-derivation make-input-addressed-derivation) "zilch-env"
+        (derivation-system drv)
+        (derivation-input-drvs drv)
+        (derivation-input-src drv)
+        (list (derivation-builder drv) "-c" processor)
+        new-env
+        '("out")))
+      (define environment (call-with-port (store-path-open (make-store-path out-drv "out" #f)) (lambda (p) (read p))))
+      (make-zexp (lambda () (zexp-context-register-items (list (list out-drv "out")) '()) environment) (lambda (p) (fprintf p "<shell environment for ~A>" (derivation-path drv)))))))
+