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

(zilch nix daemon): use record instead of list for activity information

Browse source
This commit is contained in:
puck 2024-10-09 20:57:10 +00:00
parent 84207df87d
commit 0c575ca0e4
3 changed files with 35 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

30
core/src/nix/daemon.sld
View file

@ -18,7 +18,11 @@
*logger* *logger*
daemon-wop-handshake daemon-wop-set-options daemon-wop-handshake daemon-wop-set-options
daemon-wop-add-text-to-store daemon-wop-build-paths daemon-wop-add-text-to-store daemon-wop-build-paths
daemon-wop-query-derivation-output-map) daemon-wop-query-derivation-output-map
<nix-activity> nix-activity?
nix-activity-id nix-activity-log-level nix-activity-type
nix-activity-string nix-activity-fields nix-activity-parent-id)
(begin (begin
(define-record-type <daemon-link-settings> (define-record-type <daemon-link-settings>
@ -63,11 +67,11 @@
((eqv? event 'next) (write-string data)) ((eqv? event 'next) (write-string data))
((eqv? event 'write) (write-string data)) ((eqv? event 'write) (write-string data))
((eqv? event 'error) (error data)) ((eqv? event 'error) (error data))
((and (eqv? event 'activity-start) (eq? (list-ref data 3) 104)) (set! build-activity (list-ref data 1))) ((and (eqv? event 'activity-start) (eq? (nix-activity-type data) 104)) (set! build-activity (nix-activity-id data)))
((and (eqv? event 'activity-start) (eq? (list-ref data 3) 105)) (printf "[..building ~S]\n" (vector-ref (list-ref data 5) 0))) ((and (eqv? event 'activity-start) (eq? (nix-activity-type data) 105)) (printf "[..building ~S]\n" (vector-ref (nix-activity-fields data) 0)))
((and (eqv? event 'activity-result) (eqv? (list-ref data 2) 101)) (write-string (vector-ref (cadr (cddr data)) 0)) (newline)) ((and (eqv? event 'activity-result) (eqv? (nix-activity-type data) 101)) (write-string (vector-ref (nix-activity-fields data) 0)) (newline))
((and (eqv? event 'activity-result) (eqv? (list-ref data 1) build-activity) (eqv? (list-ref data 2) 105)) ((and (eqv? event 'activity-result) (eqv? (nix-activity-id data) build-activity) (eqv? (nix-activity-type data) 105))
(let* ((ndata (list-ref data 3)) (done-builds (vector-ref ndata 0)) (total-builds (vector-ref ndata 1)) (running-builds (vector-ref ndata 2))) (let* ((ndata (nix-activity-fields data)) (done-builds (vector-ref ndata 0)) (total-builds (vector-ref ndata 1)) (running-builds (vector-ref ndata 2)))
(printf "[~S/~S builds, ~S running]\n" done-builds total-builds running-builds))))))) (printf "[~S/~S builds, ~S running]\n" done-builds total-builds running-builds)))))))
;; Reads a list of log events until STDERR_LAST is called. ;; Reads a list of log events until STDERR_LAST is called.
@ -100,6 +104,16 @@
(if (> count 0) (read-field fields 0 count)) (if (> count 0) (read-field fields 0 count))
fields))) fields)))
(define-record-type <nix-activity>
(make-nix-activity id log-level type string fields parent-id)
nix-activity?
(id nix-activity-id)
(log-level nix-activity-log-level)
(type nix-activity-type)
(string nix-activity-string)
(fields nix-activity-fields)
(parent-id nix-activity-parent-id))
;; Read an activity-start object from the provided <daemon-link>. ;; Read an activity-start object from the provided <daemon-link>.
(define (daemon-read-activity-start link) (define (daemon-read-activity-start link)
(define act (daemon-read-u64 link)) (define act (daemon-read-u64 link))
@ -108,14 +122,14 @@
(define s (daemon-read-string link)) (define s (daemon-read-string link))
(define fields (daemon-read-activity-fields link)) (define fields (daemon-read-activity-fields link))
(define parent (daemon-read-u64 link)) (define parent (daemon-read-u64 link))
`(activity-start ,act ,lvl ,typ ,s ,fields ,parent)) (make-nix-activity act lvl typ s fields parent))
;; Read an activity-result object from the provided <daemon-link>. ;; Read an activity-result object from the provided <daemon-link>.
(define (daemon-read-activity-result link) (define (daemon-read-activity-result link)
(define act (daemon-read-u64 link)) (define act (daemon-read-u64 link))
(define typ (daemon-read-u64 link)) (define typ (daemon-read-u64 link))
(define fields (daemon-read-activity-fields link)) (define fields (daemon-read-activity-fields link))
`(activity-result ,act ,typ ,fields)) (make-nix-activity act #f typ #f fields #f))
;; Read an Error object from the provided <daemon-link>. ;; Read an Error object from the provided <daemon-link>.
(define (daemon-read-error link) (define (daemon-read-error link)

23
core/src/statusbar.sld
View file

@ -3,6 +3,7 @@
(scheme base) (scheme write) (scheme base) (scheme write)
(srfi 18) (srfi 128) (srfi 146) (srfi 151) (srfi 152) (srfi 18) (srfi 128) (srfi 146) (srfi 151) (srfi 152)
(chicken base) (chicken format) (chicken port) (chicken process signal) (chicken base) (chicken format) (chicken port) (chicken process signal)
(zilch nix daemon)
(zilch magic)) (zilch magic))
(export (export
@ -140,26 +141,26 @@
((eqv? event 'next) (bypass-write (string->utf8 (string-copy data 0 (- (string-length data) 1))))) ((eqv? event 'next) (bypass-write (string->utf8 (string-copy data 0 (- (string-length data) 1)))))
((eqv? event 'write) (bypass-write (string->utf8 data))) ; TODO(puck): is this ever called? ((eqv? event 'write) (bypass-write (string->utf8 data))) ; TODO(puck): is this ever called?
((eqv? event 'error) (error data)) ((eqv? event 'error) (error data))
((and (eqv? event 'activity-start) (eq? (list-ref data 3) 104)) (set! last-builds-activity-id (list-ref data 1))) ((and (eqv? event 'activity-start) (eq? (nix-activity-type data) 104)) (set! last-builds-activity-id (nix-activity-id data)))
((and (eqv? event 'activity-start) (eq? (list-ref data 3) 105)) ((and (eqv? event 'activity-start) (eq? (nix-activity-type data) 105))
(set! build-activity-mapping (set! build-activity-mapping
(mapping-set! build-activity-mapping (list-ref data 1) (mapping-set! build-activity-mapping (nix-activity-id data)
(string-drop (string-drop-while (vector-ref (list-ref data 5) 0) (lambda (f) (not (char=? f #\-)))) 1)))) (string-drop (string-drop-while (vector-ref (nix-activity-fields data) 0) (lambda (f) (not (char=? f #\-)))) 1))))
((eqv? event 'activity-start) (set! last-activity-start-id (list-ref data 1)) (set! last-activity-start (list-ref data 4)) (rerender-status-bar)) ((eqv? event 'activity-start) (set! last-activity-start-id (nix-activity-id data)) (set! last-activity-start (nix-activity-string data)) (rerender-status-bar))
((eqv? event 'activity-stop) ((eqv? event 'activity-stop)
(set! build-activity-mapping (mapping-delete! build-activity-mapping data))) (set! build-activity-mapping (mapping-delete! build-activity-mapping data)))
((and (eqv? event 'activity-result) (eqv? (list-ref data 2) 101)) ((and (eqv? event 'activity-result) (eqv? (nix-activity-type data) 101))
(let ((drv-name (mapping-ref/default build-activity-mapping (list-ref data 1) #f))) (let ((drv-name (mapping-ref/default build-activity-mapping (nix-activity-id data) #f)))
(when drv-name (when drv-name
(let ((msg (string-append drv-name "> " (vector-ref (list-ref data 3) 0)))) (let ((msg (string-append drv-name "> " (vector-ref (nix-activity-fields data) 0))))
(mutex-lock! out-mutex) (mutex-lock! out-mutex)
(set! last-activity-start msg) (set! last-activity-start msg)
(set! last-activity-start-id (list-ref data 1)) (set! last-activity-start-id (nix-activity-id data))
(mutex-unlock! out-mutex) (mutex-unlock! out-mutex)
(when print-logs (when print-logs
(bypass-write (string->utf8 msg))))))) (bypass-write (string->utf8 msg)))))))
((and (eqv? event 'activity-result) (eqv? (list-ref data 1) last-builds-activity-id)) ((and (eqv? event 'activity-result) (eqv? (nix-activity-id data) last-builds-activity-id))
(set! last-builds-activity-data (list-ref data 3)) (set! last-builds-activity-data (nix-activity-fields data))
(rerender-status-bar)))) (rerender-status-bar))))
(thread-start! redraw-thread) (thread-start! redraw-thread)
(thread-start! terminal-width-thread) (thread-start! terminal-width-thread)

2
core/zilch.egg
View file

@ -36,6 +36,6 @@
(component-dependencies zilch.lib.hash zilch.nix.hash zilch.nix.path)) (component-dependencies zilch.lib.hash zilch.nix.hash zilch.nix.path))
(extension zilch.statusbar (extension zilch.statusbar
(source "src/statusbar.sld") (source "src/statusbar.sld")
(component-dependencies zilch.magic)) (component-dependencies zilch.magic zilch.nix.daemon))
(extension zilch.lib.getopt (extension zilch.lib.getopt
(source "src/lib/getopt.sld")))) (source "src/lib/getopt.sld"))))