From 2f56e3e67d7f2744c5eca39cb87adb9c77271110 Mon Sep 17 00:00:00 2001
From: zimoun <zimon.toutoune@gmail.com>
Date: Sun, 3 May 2020 17:01:52 +0200
Subject: DRAFT packages: Add fields to packages cache.

---
 gnu/packages.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 46 insertions(+), 5 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index d22c992bb1..fa18f81487 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -33,6 +33,8 @@
   #:use-module (guix profiles)
   #:use-module (guix describe)
   #:use-module (guix deprecation)
+  #:use-module (guix build-system)
+  #:use-module (guix licenses)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 binary-ports)
@@ -212,7 +214,8 @@ package module."
                     (match vector
                       (#(name version module symbol outputs
                               supported? deprecated?
-                              file line column)
+                              file line column
+                              _ _ _ _ _ _ _ _ _ _)
                        (proc name version result
                              #:outputs outputs
                              #:location (and file
@@ -269,7 +272,11 @@ package names.  Return #f on failure."
                    (match item
                      (#(name version module symbol outputs
                              supported? deprecated?
-                             file line column)
+                             file line column
+                             synopsis description home-page
+                             build-system-name build-system-description
+                             supported-systems direct-inputs
+                             license-name license-uri license-comment)
                       (vhash-cons name item vhash))))
                  vlist-null
                  lst))
@@ -316,7 +323,8 @@ decreasing version order."
   (if (and (cache-is-authoritative?) cache)
       (match (cache-lookup cache name)
         (#f #f)
-        ((#(_ versions modules symbols _ _ _ _ _ _) ...)
+        ((#(_ versions modules symbols _ _ _ _ _ _
+              _ _ _ _ _ _ _ _ _ _) ...)
          (fold (lambda (version* module symbol result)
                  (if (or (not version)
                          (version-prefix? version version*))
@@ -339,7 +347,8 @@ matching NAME and VERSION."
         (#f '())
         ((#(name versions modules symbols outputs
                  supported? deprecated?
-                 files lines columns) ...)
+                 files lines columns
+                 _ _ _ _ _ _ _ _ _ _) ...)
          (fold (lambda (version* file line column result)
                  (if (and file
                           (or (not version)
@@ -401,7 +410,39 @@ reducing the memory footprint."
                                      `(,(location-file loc)
                                        ,(location-line loc)
                                        ,(location-column loc))
-                                     '(#f #f #f))))
+                                     '(#f #f #f)))
+
+                             ,(package-synopsis package)
+                             ,(package-description package)
+                             ,(package-home-page package)
+
+                             ,@(let ((build-system
+                                       (package-build-system package)))
+                                 `(,(symbol->string
+                                     (build-system-name build-system))
+                                   ,(build-system-description build-system)))
+
+                             ,(package-transitive-supported-systems package)
+
+                             ,(delete-duplicates
+                               (sort (map package-full-name
+                                          (match (package-direct-inputs package)
+                                            (((labels inputs . _) ...)
+                                             (filter package? inputs))))
+                                     string<?))
+
+                             ,@(match (package-license package)
+                                 (((? license? licenses) ...) ; multilicenses
+                                  `(,(string-join (map license-name licenses)
+                                                  ", ")
+                                    ,(license-uri (car licenses)) ;TODO: names>uris?
+                                    ;; see gpl1+ comment #f
+                                    ,(license-comment (car licenses))))
+                                 ((? license? license)
+                                  `(,(license-name license)
+                                    ,(license-uri license)
+                                    ,(license-comment license)))
+                                 (_ '(#f #f #f))))
                           result)
                     (vhash-consq package #t seen))))))
       (_
-- 
cgit v1.2.3