explore.scm

@@ -1,3 +1,6 @@
+#!/bin/sh
+exec "${GUILE:-guile}" -e "(@ (explore) guix-explore)" -s "$0" "$@"
+!#
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
@@ -21,7 +24,9 @@
   #:use-module (guix)
   #:use-module (guix i18n)
   #:use-module (gnu services)
+  #:autoload   (gnu services desktop) (%desktop-services)
   #:use-module (guix gexp)
+  #:use-module (guix ui)
   #:use-module (json)
   #:use-module (sxml simple)
   #:autoload   (texinfo) (texi-fragment->stexi)
@@ -37,6 +42,7 @@
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 binary-ports)
+  #:export (guix-explore)
   #:declarative? #f)                              ;for Geiser
 
 ;;; Commentary:
@@ -288,10 +294,13 @@ remaining services--i.e., those that have not been folded."
         (nodes (loop (append-map back-edges nodes)
                      (append nodes result))))))
 
-  (cons updated-root
-        (remove (lambda (service)
-                  (memq service dependents))
-                services)))
+  (values (cons updated-root
+                ;; FIXME: Remove the edges to ROOT rather than all of
+                ;; DEPENDENTS.
+                (remove (lambda (service)
+                          (memq service dependents))
+                        services))
+          updated-root))
 
 (define (render-folding request view id)
   "Respond to REQUEST, which is about folding services to ID."
@@ -300,14 +309,15 @@ remaining services--i.e., those that have not been folded."
             (string=? (service-node-id service) id))
           (view-services view)))
 
-  (values (build-response #:code 200)
-          "Folded!"
-          (set-fields view
-                      ((view-services)
-                       (compute-folding (view-services view)
-                                        root))
-                      ((view-previous-view)
-                       view))))
+  (let ((services updated-root (compute-folding (view-services view)
+                                                root)))
+    (values '((content-type . (application/json (charset . "UTF-8"))))
+            ;; Return the ID of UPDATED-ROOT so it can be highlighted.
+            (scm->json-string
+             `((id . ,(service-node-id updated-root))))
+            (set-fields view
+                        ((view-services) services)
+                        ((view-previous-view) view)))))
 
 (define (render-previous-view request view)
   "Respond to REQUEST by restoring the previous view--IOW, \"undoing\" the
@@ -336,6 +346,7 @@ latest changes."
     (cond ((memq service (view-essential-services view))
            'essential)
           ((memq service %base-services)     'base)
+          ((memq service %desktop-services)  'desktop)
           (else                              'user)))
 
   (define services
@@ -372,8 +383,8 @@ latest changes."
 
 (use-modules (gnu tests))
 
-(define* (run-explore-server #:optional
-                             (os (simple-operating-system)))
+(define* (run-explore-server #:optional (os (simple-operating-system))
+                             #:key (port 8080))
   (define user-services
     (operating-system-user-services os))
 
@@ -384,6 +395,23 @@ latest changes."
     (instantiate-missing-services
      (append user-services essential-services)))
 
-  (run-server handle-request (lookup-server-impl 'http) '()
+  (info (G_ "Open a browser at ~a and start exploring!~%")
+        (string-append "http://localhost:" (number->string port)))
+  (run-server handle-request (lookup-server-impl 'http)
+              `(#:port ,port)
               (view user-services essential-services
                     services services #f)))
+
+(define (guix-explore args)
+  (define %user-module                     ;copied from (guix scripts system)
+    ;; Module in which the machine description file is loaded.
+    (make-user-module '((gnu system)
+                        (gnu services)
+                        (gnu system shadow))))
+
+  (with-error-handling
+    (match args
+      ((_ file)
+       (run-explore-server (load* file %user-module)))
+      (_
+       (leave (G_ "Usage: explore FILE~%"))))))

graph.js

@@ -23,6 +23,9 @@
 // Visibility of the "undo" button.
 var undoVisibility = "hidden";
 
+// ID of a highlighted node.
+var highlightedNodeID = null;
+
 chart = function(links, nodes) {
     console.log("chart with " + nodes.length + " nodes and "
 		+ links.length + " edges");
@@ -95,6 +98,7 @@ chart = function(links, nodes) {
     function nodeColor (node) {
 	if (node.category == "essential") return "#ff4466";
 	else if (node.category == "base") return "#bb3344";
+	else if (node.category == "desktop") return "#3344bb";
 	else return "#bbb";
     }
 
@@ -131,6 +135,9 @@ chart = function(links, nodes) {
 	.attr("font-size", "4px")
 	.attr("color", labelColor)
 	.attr("text-align", "center")
+	.classed("highlighted-node", n => {
+	    return n.id == highlightedNodeID;
+	})
 	.text(d => d.label)
 	.on("mouseover", event => {
 	    // Display service type documentation.
@@ -160,8 +167,9 @@ chart = function(links, nodes) {
 	.on("dblclick", event => {
 	    const node = event.target.__data__;
 	    console.log("folding " + node.id);
-	    d3.text("/fold/" + node.id).then(element => {
+	    d3.json("/fold/" + node.id).then(folded => {
 		undoVisibility = "visible";
+		highlightedNodeID = folded.id;
 		redraw();
 	    });
 	})

style.css

@@ -17,6 +17,24 @@
     z-index: 1;
 }
 
+@keyframes blink {
+    0% {
+        color: #000;
+    }
+    67% {
+	color: #08b;
+	text-shadow: 0px 0px 3px #9cf;
+    }
+    100% {
+        color: #000;
+    }
+}
+
+.highlighted-node {
+    padding: 10px;
+    animation: blink normal 1.5s infinite ease-in-out;
+}
+
 /* Control area.  */
 
 .control-area {