Add a page to show a formatted derivation representation

The HTML is very rough, and the way it's displayed is also rough, but it does
provide a way to understand the derivation. I'm also unsure it's a perfect
representation, but it's a start at least.

2 files changed, 240 insertions, 0 deletions

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 27b195c..feac0f1 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -118,6 +118,32 @@
                  "No derivation found with this file name.")
          #:code 404))))
 
+(define (render-formatted-derivation conn derivation-file-name)
+  (let ((derivation (select-derivation-by-file-name conn
+                                                    derivation-file-name)))
+    (if derivation
+        (let ((derivation-inputs (select-derivation-inputs-by-derivation-id
+                                  conn
+                                  (first derivation)))
+              (derivation-outputs (select-derivation-outputs-by-derivation-id
+                                   conn
+                                   (first derivation)))
+              (derivation-sources (select-derivation-sources-by-derivation-id
+                                   conn
+                                   (first derivation))))
+          (render-html
+           #:sxml (view-formatted-derivation derivation
+                                             derivation-inputs
+                                             derivation-outputs
+                                             derivation-sources)
+           #:extra-headers http-headers-for-unchanging-content))
+
+        (render-html
+         #:sxml (general-not-found
+                 "Derivation not found"
+                 "No derivation found with this file name.")
+         #:code 404))))
+
 (define (render-store-item conn filename)
   (let ((derivation (select-derivation-by-output-filename conn filename)))
     (match derivation
@@ -239,6 +265,11 @@
        (if (string-suffix? ".drv" path)
            (render-derivation conn path)
            (render-store-item conn path))))
+    (('GET "gnu" "store" filename "formatted")
+     (if (string-suffix? ".drv" filename)
+         (render-formatted-derivation conn
+                                      (string-append "/gnu/store/" filename))
+         (not-found (request-uri request))))
     (('GET "compare" _ ...)             (delegate-to compare-controller))
     (('GET "compare-by-datetime" _ ...) (delegate-to compare-controller))
     (('GET "jobs")         (delegate-to jobs-controller))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index ae9fe0e..ea5641a 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -43,6 +43,7 @@
             view-statistics
             view-builds
             view-derivation
+            view-formatted-derivation
             view-store-item
             error-page))
 
@@ -451,6 +452,15 @@
        ,(string-append
          "/" (string-join fileparts "/"))))))
 
+(define (display-file-in-store-item-oneline filename)
+  (match (string-split filename #\/)
+    (("" "gnu" "store" item fileparts ...)
+     `(,(let ((full-item (string-append "/gnu/store/" item)))
+          `(a (@ (href ,full-item))
+              ,(display-store-item full-item)))
+       ,(string-append
+         "/" (string-join fileparts "/"))))))
+
 (define (view-store-item filename derivations derivations-using-store-item-list)
   (layout
    #:body
@@ -576,6 +586,205 @@
                              ,(display-store-item-short path))))))
                  derivation-outputs)))))))))
 
+(define (view-formatted-derivation derivation derivation-inputs derivation-outputs
+                                   derivation-sources)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      ,(match derivation
+         ((id file-name builder args env-vars system)
+          `(div
+            (@ (class "row"))
+            (div
+             (@ (class "col-sm-12"))
+             ,(display-store-item-title file-name)))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-offset-2 col-md-10")
+           (style "font-family: monospace; font-size: 1.5em;"))
+        "Derive("))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-offset-2 col-md-10")
+           (style "font-family: monospace;"))
+        (span (@ (style "margin-left: 1.5em;"))
+              "[")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-2"))
+        "Outputs")
+       (div
+        (@ (class "col-md-10")
+           (style "font-family: monospace;"))
+        ,@(map (match-lambda*
+                 (((output-name path hash-algorithm hash recursive?) count-down)
+                  `(div
+                    (@ (style "margin-left: 3em;"))
+                    ,(simple-format #f "(\"~A\",\"" output-name)
+                    (a (@ (href ,path))
+                       ,(display-store-item path))
+                    "\")"
+                    ,@(if (eq? count-down 0)
+                          '()
+                          '(",")))))
+               derivation-outputs
+               (reverse (iota (length derivation-outputs))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-offset-2 col-md-10")
+           (style "font-family: monospace;"))
+        (span (@ (style "margin-left: 1.5em;"))
+              "],[")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-2"))
+        "Inputs")
+       (div
+        (@ (class "col-md-10")
+           (style "font-family: monospace;"))
+        ,@(map (match-lambda*
+                 (((file-name output-name path) count-down)
+                  `(div
+                    (@ (style "margin-left: 3em;"))
+                    "(\""
+                    (a (@ (href ,file-name))
+                       ,(display-store-item file-name))
+                    "\",\""
+                    "[\"" ,output-name "\"]"
+                    ")"
+                    ,@(if (eq? count-down 0)
+                          '()
+                          '(",")))))
+               derivation-inputs
+               (reverse (iota (length derivation-inputs))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-offset-2 col-md-10")
+           (style "font-family: monospace;"))
+        (span (@ (style "margin-left: 1.5em;"))
+              "],[")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-2"))
+        "Sources")
+       (div
+        (@ (class "col-md-10")
+           (style "font-family: monospace;"))
+        ,@(map (lambda (source count-down)
+                 `(div (@ (style "margin-left: 3em;"))
+                       "\""
+                       (a (@ (href ,source))
+                          ,(display-store-item source))
+                       "\""
+                       ,@(if (eq? count-down 0)
+                             '()
+                             '(","))))
+               derivation-sources
+               (reverse (iota (length derivation-sources))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-offset-2 col-md-10")
+           (style "font-family: monospace;"))
+        (span (@ (style "margin-left: 1.5em;"))
+              "],")))
+      ,@(match derivation
+          ((id file-name builder args env-vars system)
+           `((div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-2"))
+               "System")
+              (div
+               (@ (class "col-md-10")
+                  (style "font-family: monospace;"))
+               (span (@ (style "margin-left: 1.5em;"))
+                     "\"" ,system "\",")))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-2"))
+               "Builder")
+              (div
+               (@ (class "col-md-10")
+                  (style "font-family: monospace;"))
+               (span (@ (style "margin-left: 1.5em;"))
+                     ,@(if (string=? "builtin:download"
+                                     builder)
+                           '("builtin:download")
+                           `("\""
+                             (a (@ (href ,builder))
+                                ,(display-file-in-store-item-oneline builder))
+                             "\""))
+                     ",")))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-offset-2 col-md-10")
+                  (style "font-family: monospace;"))
+               (span (@ (style "margin-left: 1.5em;"))
+                     "[")))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-2"))
+               "Arguments")
+              (div
+               (@ (class "col-md-10")
+                  (style "font-family: monospace;"))
+               (div
+                (@ (style "margin-left: 3em;"))
+                ,@(map (lambda (arg count-down)
+                         `(div "\""
+                               ,arg
+                               "\""
+                               ,@(if (eq? count-down 0)
+                                     '()
+                                     '(","))))
+                       args
+                       (reverse (iota (length args)))))))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-offset-2 col-md-10")
+                  (style "font-family: monospace;"))
+               (span (@ (style "margin-left: 1.5em;"))
+                     "],[")))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-2"))
+               "Environment variables")
+              (div
+               (@ (class "col-md-10")
+                  (style "font-family: monospace;"))
+               ,@(map (lambda (env-var count-down)
+                        `(div (@ (style "margin-left: 3em;"))
+                              "("
+                              "\"" ,(assq-ref env-var 'key) "\""
+                              ","
+                              "\"" ,(assq-ref env-var 'value) "\""
+                              ")"))
+                      env-vars
+                      (reverse (iota (length env-vars))))
+               (span (@ (style "margin-left: 1.5em;"))
+                     "]")))
+             (div
+              (@ (class "row"))
+              (div
+               (@ (class "col-md-offset-2 col-md-10")
+                  (style "font-family: monospace; font-size: 1.5em;"))
+               ")")))))))))
+
 (define (general-not-found header-text body)
   (layout
    #:body