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*
daemon-wop-handshake daemon-wop-set-options
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
(define-record-type <daemon-link-settings>
@ -63,11 +67,11 @@
((eqv? event 'next) (write-string data))
((eqv? event 'write) (write-string 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? (list-ref data 3) 105)) (printf "[..building ~S]\n" (vector-ref (list-ref data 5) 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? (list-ref data 1) build-activity) (eqv? (list-ref data 2) 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)))
((and (eqv? event 'activity-start) (eq? (nix-activity-type data) 104)) (set! build-activity (nix-activity-id data)))
((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? (nix-activity-type data) 101)) (write-string (vector-ref (nix-activity-fields data) 0)) (newline))
((and (eqv? event 'activity-result) (eqv? (nix-activity-id data) build-activity) (eqv? (nix-activity-type data) 105))
(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)))))))
;; Reads a list of log events until STDERR_LAST is called.
@ -100,6 +104,16 @@
(if (> count 0) (read-field fields 0 count))
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>.
(define (daemon-read-activity-start link)
(define act (daemon-read-u64 link))
@ -108,14 +122,14 @@
(define s (daemon-read-string link))
(define fields (daemon-read-activity-fields 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>.
(define (daemon-read-activity-result link)
(define act (daemon-read-u64 link))
(define typ (daemon-read-u64 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>.
(define (daemon-read-error link)

23
core/src/statusbar.sld
View file

@ -3,6 +3,7 @@
(scheme base) (scheme write)
(srfi 18) (srfi 128) (srfi 146) (srfi 151) (srfi 152)
(chicken base) (chicken format) (chicken port) (chicken process signal)
(zilch nix daemon)
(zilch magic))
(export
@ -140,26 +141,26 @@
((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 '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? (list-ref data 3) 105))
((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? (nix-activity-type data) 105))
(set! build-activity-mapping
(mapping-set! build-activity-mapping (list-ref data 1)
(string-drop (string-drop-while (vector-ref (list-ref data 5) 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))
(mapping-set! build-activity-mapping (nix-activity-id data)
(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 (nix-activity-id data)) (set! last-activity-start (nix-activity-string data)) (rerender-status-bar))
((eqv? event 'activity-stop)
(set! build-activity-mapping (mapping-delete! build-activity-mapping data)))
((and (eqv? event 'activity-result) (eqv? (list-ref data 2) 101))
(let ((drv-name (mapping-ref/default build-activity-mapping (list-ref data 1) #f)))
((and (eqv? event 'activity-result) (eqv? (nix-activity-type data) 101))
(let ((drv-name (mapping-ref/default build-activity-mapping (nix-activity-id data) #f)))
(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)
(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)
(when print-logs
(bypass-write (string->utf8 msg)))))))
((and (eqv? event 'activity-result) (eqv? (list-ref data 1) last-builds-activity-id))
(set! last-builds-activity-data (list-ref data 3))
((and (eqv? event 'activity-result) (eqv? (nix-activity-id data) last-builds-activity-id))
(set! last-builds-activity-data (nix-activity-fields data))
(rerender-status-bar))))
(thread-start! redraw-thread)
(thread-start! terminal-width-thread)