[bug#44460] processes: Don't normalize Locks

[John Soo <jsoo1@asu.edu>]

[-- Attachment #1: Type: text/plain, Size: 240 bytes --]

I got a little eager to normalize and put locks in their own record
set. That was unnecessary as records can have multiple of the same field
name. This new patch removes the Lock record set and puts the Lock in
the Session record.

- John


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-processes-Optionally-normalize-recutils-output.patch --]
[-- Type: text/x-patch, Size: 6612 bytes --]

From 699c66987885d91788ea0707a819270ca9fb2e1e Mon Sep 17 00:00:00 2001
From: John Soo <jsoo1@asu.edu>
Date: Wed, 4 Nov 2020 07:51:52 -0800
Subject: [PATCH] processes: Optionally normalize recutils output.

* guix/scripts/processes.scm: Add "normalize" flag
---
 doc/guix.texi              |  26 ++++++++++
 guix/scripts/processes.scm | 103 ++++++++++++++++++++++++++++++++-----
 2 files changed, 117 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5e3e0435b4..ed54c26072 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12691,6 +12691,32 @@ ClientPID: 19419
 ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
 @end example
 
+Additional options are listed below.
+
+@table @code
+@item --normalize
+Normalize the output records into record sets (@pxref{Record Sets,,,
+recutils, GNU recutils manual}).  Normalizing into record sets allows
+joins across record types.
+
+@example
+$ guix processes --normalize | \
+    recsel \
+    -j Session \
+    -t ChildProcess \
+    -p Session.PID,PID \
+    -e 'Session.ClientCommand ~ build'
+Session_PID: 4278
+PID: 4435
+
+Session_PID: 4278
+PID: 4554
+
+Session_PID: 4278
+PID: 4646
+@end example
+@end table
+
 @node System Configuration
 @chapter System Configuration
 
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index b4ca7b1687..6828cf576e 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -176,6 +176,9 @@ active sessions, and the master 'guix-daemon' process."
     (values (filter-map child-process->session children)
             master)))
 
+(define (lock->record lock port)
+  (format port "LockHeld: ~a~%" lock))
+
 (define (daemon-session->recutils session port)
   "Display SESSION information in recutils format on PORT."
   (format port "SessionPID: ~a~%"
@@ -184,8 +187,7 @@ active sessions, and the master 'guix-daemon' process."
           (process-id (daemon-session-client session)))
   (format port "ClientCommand:~{ ~a~}~%"
           (process-command (daemon-session-client session)))
-  (for-each (lambda (lock)
-              (format port "LockHeld: ~a~%" lock))
+  (for-each (lambda (lock) (lock->record lock port))
             (daemon-session-locks-held session))
   (for-each (lambda (process)
               (format port "ChildProcess: ~a:~{ ~a~}~%"
@@ -193,6 +195,80 @@ active sessions, and the master 'guix-daemon' process."
                       (process-command process)))
             (daemon-session-children session)))
 
+(define (format-single-record port)
+  "Display denormalized session information to PORT."
+  (for-each (lambda (session)
+              (daemon-session->recutils session port)
+                (newline port))
+            (daemon-sessions)))
+
+(define session-rec-type
+  ;; Also includes ClientCommand and LockHeld but it doesn't seem to be
+  ;; possible to express a plain string field (the default) without further
+  ;; restrictions
+  "%rec: Session
+%type: PID int
+%type: ClientPID int
+%key: PID")
+
+(define child-process-rec-type
+  ;; Also includes Command but it doesn't seem to be possible to
+  ;; express a plain string field (the default) without further restrictions
+  "%rec: ChildProcess
+%type: Session rec Session
+%type: PID int
+%key: PID")
+
+(define (session-key->field session port)
+  "Display SESSION PID as field on PORT."
+  (format
+   port "Session: ~a"
+   (process-id (daemon-session-process session))))
+
+(define (session-scalars->normalized-record session port)
+  "Display SESSION scalar fields to PORT in normalized form."
+  (format port "PID: ~a~%"
+          (process-id (daemon-session-process session)))
+  (format port "ClientPID: ~a~%"
+          (process-id (daemon-session-client session)))
+  (format port "ClientCommand:~{ ~a~}~%"
+          (process-command (daemon-session-client session))))
+
+(define (child-process->normalized-record process port)
+  "Display PROCESS record on PORT in normalized form"
+  (format port "PID: ~a" (process-id process))
+  (newline port)
+  (format port "Command:~{ ~a~}" (process-command process)))
+
+(define (format-normalized port)
+  (define sessions (daemon-sessions))
+
+  (format port session-rec-type)
+  (newline port)
+  (newline port)
+  (for-each
+   (lambda (session)
+     (session-scalars->normalized-record session port)
+     (for-each (lambda (lock) (lock->record lock port))
+      (daemon-session-locks-held session)))
+   sessions)
+  (newline port)
+
+  (format port child-process-rec-type)
+  (newline port)
+  (newline port)
+  (for-each
+   (lambda (session)
+     (for-each
+      (lambda (process)
+        (session-key->field session port)
+        (newline port)
+        (child-process->normalized-record process port)
+        (newline port)
+        (newline port))
+      (daemon-session-children session)))
+   sessions))
+
 \f
 ;;;
 ;;; Options.
@@ -205,7 +281,10 @@ active sessions, and the master 'guix-daemon' process."
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
-                  (show-version-and-exit "guix processes")))))
+                  (show-version-and-exit "guix processes")))
+        (option '("normalize") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'normalize #t result)))))
 
 (define (show-help)
   (display (G_ "Usage: guix processes
@@ -216,8 +295,13 @@ List the current Guix sessions and their processes."))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
+  (display (G_ "
+  --normalize            display results as normalized record sets"))
+  (newline)
   (show-bug-report-information))
 
+(define %default-options '())
+
 \f
 ;;;
 ;;; Entry point.
@@ -227,17 +311,12 @@ List the current Guix sessions and their processes."))
   (category plumbing)
   (synopsis "list currently running sessions")
   (define options
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (G_ "~A: unrecognized option~%") name))
-                cons
-                '()))
+    (parse-command-line args %options (list %default-options)))
 
   (with-paginated-output-port port
-    (for-each (lambda (session)
-                (daemon-session->recutils session port)
-                (newline port))
-              (daemon-sessions))
+    (match (assoc-ref options 'normalize)
+      (#t (format-normalized port))
+      (_ (format-single-record port)))
 
     ;; Pass 'R' (instead of 'r') so 'less' correctly estimates line length.
     #:less-options "FRX"))
-- 
2.29.1