From 0c575ca0e447888831d4f185cec20a591d8b6129 Mon Sep 17 00:00:00 2001 From: Puck Meerburg Date: Wed, 9 Oct 2024 20:57:10 +0000 Subject: [PATCH] (zilch nix daemon): use record instead of list for activity information --- core/src/nix/daemon.sld | 30 ++++++++++++++++++++++-------- core/src/statusbar.sld | 23 ++++++++++++----------- core/zilch.egg | 2 +- 3 files changed, 35 insertions(+), 20 deletions(-) diff --git a/core/src/nix/daemon.sld b/core/src/nix/daemon.sld index aca14f7..89f893c 100644 --- a/core/src/nix/daemon.sld +++ b/core/src/nix/daemon.sld @@ -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-id nix-activity-log-level nix-activity-type + nix-activity-string nix-activity-fields nix-activity-parent-id) (begin (define-record-type @@ -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 + (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 . (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 . (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 . (define (daemon-read-error link) diff --git a/core/src/statusbar.sld b/core/src/statusbar.sld index 6e33216..542c9c4 100644 --- a/core/src/statusbar.sld +++ b/core/src/statusbar.sld @@ -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) diff --git a/core/zilch.egg b/core/zilch.egg index 74eeec1..7398f54 100644 --- a/core/zilch.egg +++ b/core/zilch.egg @@ -36,6 +36,6 @@ (component-dependencies zilch.lib.hash zilch.nix.hash zilch.nix.path)) (extension zilch.statusbar (source "src/statusbar.sld") - (component-dependencies zilch.magic)) + (component-dependencies zilch.magic zilch.nix.daemon)) (extension zilch.lib.getopt (source "src/lib/getopt.sld"))))