zilch-cli-ninja: make source' and diff' operate on rewrites
Change-Id: I6a6a69644e8984ec8400e13928c8ac0e14526ad1
This commit is contained in:
parent
cdee2291fb
commit
5485b0f4ce
2 changed files with 58 additions and 29 deletions
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -10,7 +10,8 @@
|
|||
<ninja-build-config> 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 <ninja-build-config>
|
||||
(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 <finalized-drv>
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue