131 lines
5.3 KiB
Scheme
131 lines
5.3 KiB
Scheme
(import (scheme base) (scheme write) (zilch statusbar) (zilch nix daemon) (zilch magic) (zilch lib getopt) (scheme process-context) (chicken process-context) (srfi 146) (chicken port) (chicken foreign) (chicken condition))
|
|
(foreign-declare "#include <sched.h>")
|
|
|
|
(define get-cpu-count
|
|
(foreign-lambda* int ()
|
|
"cpu_set_t set; sched_getaffinity(0, sizeof(set), &set); C_return(CPU_COUNT(&set));"))
|
|
|
|
(foreign-declare "#include \"man_ninja.h\"")
|
|
(define man-page (foreign-value "man_ninja" nonnull-c-string))
|
|
|
|
(define (print-help msg)
|
|
(when msg
|
|
(write-string (string-append msg "\n\n") (current-error-port)))
|
|
(write-string man-page (current-error-port))
|
|
(exit (or (not msg) 1)))
|
|
|
|
(define-values (options args)
|
|
(getopt
|
|
'((help #f #\h)
|
|
(config-file #t #\f)
|
|
(max-jobs #t #\j)
|
|
(verbose #f #\v)
|
|
(source #t #\s)
|
|
(project #t #\p)
|
|
(print-build-logs #f #\L))
|
|
(list->vector (cdr (command-line)))
|
|
print-help))
|
|
|
|
(when (assoc 'help options) (print-help #f))
|
|
|
|
(when (null? args)
|
|
(print-help "No subcommand"))
|
|
|
|
;; Flags passed to the nix daemon:
|
|
(define max-jobs (if (assoc 'max-jobs options) (string->number (cdr (assoc 'max-jobs options))) (get-cpu-count)))
|
|
(define verbosity 3)
|
|
(for-each (lambda (val) (when (eq? (car val) 'verbose) (set! verbosity (+ 1 verbosity)))) options)
|
|
(write-string (string-append "Connected to Nix daemon, version " (daemon-link-daemon-version (*daemon*)) "\n") (current-error-port))
|
|
|
|
(daemon-wop-set-options (*daemon*) verbosity max-jobs #t)
|
|
(ca-thread-count max-jobs)
|
|
|
|
(import
|
|
(scheme base) (scheme file) (scheme read)
|
|
(chicken format) (chicken process) (chicken file)
|
|
(zilch lang ninja) (zilch lang ninja build)
|
|
(zilch lang ninja nixpkgs)
|
|
(zilch lang ninja config)
|
|
(zilch magic) (zilch nixpkgs) (zilch vfs)
|
|
(zilch nix drv)
|
|
(zilch zexpr)
|
|
(srfi 128) (srfi 146) (srfi 152))
|
|
|
|
(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 (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))))
|
|
|
|
(define (export-depfiles finalized-drv)
|
|
(define config (finalized-drv-config finalized-drv))
|
|
(when (ninja-build-config-depfile-path config)
|
|
(call-with-output-file (ninja-build-config-depfile-path config) (lambda (p) (write (mapping->alist (finalized-drv-depfile finalized-drv)) p))))
|
|
(for-each (lambda (v) (export-depfiles (force (drv-rewrite-finalized-drv v)))) (finalized-drv-rewritten-drvs finalized-drv)))
|
|
|
|
(for-each
|
|
(lambda (c)
|
|
(when (eq? (car c) 'project)
|
|
(let loop ((rewrites (ninja-build-config-rewrites config)))
|
|
(cond
|
|
((null? rewrites) (error "Subproject not found" (cdr c)))
|
|
((string=? (caar rewrites) (cdr c)) (set! config (cdar rewrites)))
|
|
(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")
|
|
(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)))
|
|
(for-each
|
|
(lambda (output-and-path)
|
|
(store-path-realised (cdr output-and-path))
|
|
(printf "~A\t-> ~S\n" (car output-and-path) (cdr output-and-path)))
|
|
(finalized-drv-output-store-paths output))
|
|
(export-depfiles output))
|
|
(let-values (((_ _ _ edge-ref defaults _) (setup-ninja-environment config)))
|
|
(for-each
|
|
(lambda (target)
|
|
(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)))))
|
|
(else
|
|
(print-help (string-append "Unknown subcommand " (car args)))))
|