diff --git a/cli/zilch-ninja.scm b/cli/zilch-ninja.scm index ef0a74d..13b7106 100644 --- a/cli/zilch-ninja.scm +++ b/cli/zilch-ninja.scm @@ -54,7 +54,7 @@ (define source (and (assoc 'source options) (cdr (assoc 'source options)))) (define config-path (if (assoc 'config-file options) (cdr (assoc 'config-file options)) "zilch.scm")) -(define config (parse-ninja-config config-path `(override-source: ,(and source (vfs-from-directory source)) ,@(call-with-input-file config-path read)))) +(define config (parse-ninja-config config-path (string=? (car args) "build")`(override-source: ,(and source (vfs-from-directory source)) ,@(call-with-input-file config-path read)))) (when (and (ninja-build-config-depfile-path config) (file-exists? (ninja-build-config-depfile-path config))) (set-ninja-build-config-depfile! config (alist->mapping (make-default-comparator) (call-with-input-file (ninja-build-config-depfile-path config) read)))) @@ -75,14 +75,43 @@ (else (loop (cdr rewrites))))))) options) +(define (do-diff config source-override is-root) + (define-values (_ configured-drv _ _ _ _ _) (setup-ninja-environment config '())) + (define path (or source-override (ninja-build-config-override-source-path config) (and is-root "src"))) + (define exit-status 0) + (when path + (let*-values + (((pid) (process-run "git" + (list "diff" "--no-index" "--" + (string-append (store-path-realised configured-drv) "/src") + path))) + ((pid normal-exit new-exit-status) (process-wait pid))) + (unless normal-exit (exit #f)) + (set! exit-status (max exit-status new-exit-status)))) + (for-each + (lambda (v) + (set! exit-status + (max exit-status + (do-diff (cdr v) #f #f)))) + (ninja-build-config-rewrites config)) + exit-status) + +(define (do-source config source-override is-root) + (define-values (_ configured-drv _ _ _ _ _) (setup-ninja-environment config '())) + (define path (or source-override (ninja-build-config-override-source-path config) (and is-root "src"))) + (when path + (system* (string-append "cp -rf --no-preserve=ownership -T " (store-path-realised configured-drv) "/src " (qs path))) + (system* (string-append "chmod -R u+rw " (qs path)))) + (for-each + (lambda (v) + (do-source (cdr v) #f #f)) + (ninja-build-config-rewrites config))) + (cond ((string=? (car args) "source") - (let*-values - (((_ configured-drv _ _ _ _ _) (setup-ninja-environment config '())) - ((realised) (store-path-realised configured-drv)) - ((path) (if (null? (cdr args)) "src" (cadr args)))) - (system* (string-append "cp -rf --no-preserve=ownership " realised "/src " (qs path))) - (system* (string-append "chmod -R u+rw " (qs path))))) + (do-source config (and (pair? (cdr args)) (cadr args)) #t)) + ((string=? (car args) "diff") + (exit (= (do-diff config source #t) 0))) ((string=? (car args) "build") (if (null? (cdr args)) (let ((output (build-nixpkgs-drv-reproducibly config))) @@ -98,11 +127,5 @@ (define built-target (edge-ref target)) (printf "~A\t-> ~S\n" target (store-path-realised (force (built-edge-out-drv (cdr built-target)))))) (cdr args))))) - ((string=? (car args) "diff") - (let*-values - (((_ configured-drv _ _ _ _ _) (setup-ninja-environment config '())) - ((realised) (store-path-realised configured-drv)) - ((path) (or source "src"))) - (process-execute "git" (list "diff" "--no-index" "--" (string-append realised "/src") path)))) (else (print-help (string-append "Unknown subcommand " (car args))))) diff --git a/lang/ninja/src/config.sld b/lang/ninja/src/config.sld index 03f516b..5831868 100644 --- a/lang/ninja/src/config.sld +++ b/lang/ninja/src/config.sld @@ -10,7 +10,8 @@ ninja-build-config? ninja-build-config-environment ninja-build-config-environment-drv ninja-build-config-root-dir ninja-build-config-patches ninja-build-config-targets - ninja-build-config-override-source ninja-build-config-depfile ninja-build-config-depfile-path + ninja-build-config-override-source ninja-build-config-override-source-path + ninja-build-config-depfile ninja-build-config-depfile-path ninja-build-config-disallow-elide ninja-build-config-rewrites set-ninja-build-config-root-dir! set-ninja-build-config-environment! set-ninja-build-config-depfile! @@ -26,7 +27,7 @@ ;; Represents a parsed Ninja build configuration. ;; See `parse-ninja-config` for the definition of these fields. (define-record-type - (make-ninja-build-config environment environment-drv root-dir patches targets override-source depfile depfile-path disallow-elide rewrites) + (make-ninja-build-config environment environment-drv root-dir patches targets override-source override-source-path depfile depfile-path disallow-elide rewrites) ninja-build-config? (environment ninja-build-config-environment set-ninja-build-config-environment!) (environment-drv ninja-build-config-environment-drv set-ninja-build-config-environment-drv!) @@ -34,6 +35,7 @@ (patches ninja-build-config-patches set-ninja-build-config-patches!) (targets ninja-build-config-targets set-ninja-build-config-targets!) (override-source ninja-build-config-override-source set-ninja-build-config-override-source!) + (override-source-path ninja-build-config-override-source-path set-ninja-build-config-override-source-path!) (depfile ninja-build-config-depfile set-ninja-build-config-depfile!) (depfile-path ninja-build-config-depfile-path set-ninja-build-config-depfile-path!) (disallow-elide ninja-build-config-disallow-elide set-ninja-build-config-disallow-elide!) @@ -46,7 +48,7 @@ (string-append (string-copy path 0 last-slash) "/" path2) path2)))) - (define (parse-config-inner path conf data) + (define (parse-config-inner path accept-override conf data) (cond ((null? data) conf) ((null? (cdr data)) (error "Expected even list of directives in Zilch Ninja config")) @@ -58,19 +60,22 @@ (set-ninja-build-config-environment! conf (environment-for-derivation drv)) (set-ninja-build-config-environment-drv! conf (store-path-drv drv))) (set-ninja-build-config-environment! conf (list-ref data 1))) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:root) (set-ninja-build-config-root-dir! conf (if (string? (list-ref data 1)) (vfs-from-directory (list-ref data 1)) (list-ref data 1))) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:override-source) - (set-ninja-build-config-override-source! conf (if (string? (list-ref data 1)) (vfs-from-directory (relative-to-file path (list-ref data 1))) (list-ref data 1))) - (parse-config-inner path conf (cddr data))) + (when (string? (list-ref data 1)) + (set-ninja-build-config-override-source-path! conf (relative-to-file path (list-ref data 1)))) + (when accept-override + (set-ninja-build-config-override-source! conf (if (string? (list-ref data 1)) (vfs-from-directory (relative-to-file path (list-ref data 1))) (list-ref data 1)))) + (parse-config-inner path accept-override conf (cddr data))) ((#:depfile-path) (set-ninja-build-config-depfile-path! conf (relative-to-file path (list-ref data 1))) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:depfile) (set-ninja-build-config-depfile! conf (list-ref data 1)) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:patch) (let* ((patch-base (list-ref data 1)) @@ -82,7 +87,7 @@ (scheme-eval patch-base)) (else patch-base)))) (set-ninja-build-config-patches! conf (cons processed-patch (ninja-build-config-patches conf)))) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:disallow-elide) (let* ((thunk (list-ref data 1)) @@ -92,7 +97,7 @@ (scheme-eval thunk)) (else thunk)))) (set-ninja-build-config-disallow-elide! conf processed-thunk)) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:target #:targets) (when (eq? (ninja-build-config-targets conf) #f) (set-ninja-build-config-targets! conf '())) @@ -100,12 +105,12 @@ ((val (list-ref data 1)) (list-val (if (list? val) val (list val)))) (set-ninja-build-config-targets! conf (append list-val (ninja-build-config-targets conf)))) - (parse-config-inner path conf (cddr data))) + (parse-config-inner path accept-override conf (cddr data))) ((#:rewrite) (let* ((val (list-ref data 1))) - (set-ninja-build-config-rewrites! conf (cons (cons (car val) (parse-ninja-config path (cdr val))) (ninja-build-config-rewrites conf)))) - (parse-config-inner path conf (cddr data))) + (set-ninja-build-config-rewrites! conf (cons (cons (car val) (parse-ninja-config path accept-override (cdr val))) (ninja-build-config-rewrites conf)))) + (parse-config-inner path accept-override conf (cddr data))) (else (error (string-append "Unknown directive " (keyword->string (car data)) " parsing Zilch Ninja config"))))))) ;; Parses a Zilch Ninja configuration file. @@ -141,10 +146,11 @@ ;; name. ;; ;; `path` is the path this file was located at, used to resolve relative paths for depfiles. - (define (parse-ninja-config path config) + ;; `accept-override` specifies whether override-source arguments are processed. + (define (parse-ninja-config path accept-override config) (unless (list? config) (error "expected Zilch Ninja config to be a list")) - (parse-config-inner path (make-ninja-build-config #f #f #f '() #f #f #f #f #f '()) config)) + (parse-config-inner path accept-override (make-ninja-build-config #f #f #f '() #f #f #f #f #f #f '()) config)) ;; `source-paths`: mapping of original store path to virtual path. ;; `finalized-drv`: promise of a