puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch core nixpkgs): add "eval raw in nixpkgs" function

Browse source 
This allows evaluating code that isn't as obviously "one derivation";
e.g. `pkgs.mkShell'.
This commit is contained in:
puck 2025-04-29 15:04:43 +00:00
parent 5176533e0a
commit 80883d3206
1 changed files with 76 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

80
core/src/nixpkgs.sld
View file

@ -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)))))))