[PATCH] website: packages: Anchor location url to commit id.

[PATCH] website: packages: Anchor location url to commit id.

[ericbavier]

From: Eric Bavier <bavier@member.fsf.org>

* website/www/packages.scm (git-description): New variable.
(location-url): Include "?id=..." if possible.
---
 website/www/packages.scm | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/website/www/packages.scm b/website/www/packages.scm
index 91784ec..30153d5 100644
--- a/website/www/packages.scm
+++ b/website/www/packages.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
 ;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
+;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
 ;;; Initially written by Luis Felipe López Acevedo <felipe.lopez@openmailbox.org>
 ;;; who waives all copyright interest on this file.
 ;;;
@@ -35,6 +36,7 @@
   #:use-module (guix base32)
   #:use-module ((guix download) #:select (%mirrors))
   #:use-module ((guix build download) #:select (maybe-expand-mirrors))
+  #:use-module (guix build utils)
   #:use-module (guix scripts lint)
   #:use-module (guix scripts challenge)
   #:use-module (guix scripts substitute)
@@ -47,6 +49,8 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 i18n)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -82,10 +86,24 @@
        (loop tail
              (cons* head item result))))))
 
+(define git-description
+  (delay
+   (let* ((guix (find (lambda (p)
+                        (file-exists? (string-append p "/guix/config.scm")))
+                      %load-path))
+          (pipe (with-directory-excursion guix
+                  (open-pipe* OPEN_READ "git" "describe")))
+          (desc (read-line pipe))
+          (git? (close-pipe pipe)))
+     (and git? desc))))
+
 (define (location-url loc)
   (string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
-                 (location-file loc) "#n"
-                 (number->string (location-line loc))))
+                 (location-file loc)
+                 (or (and=> (force git-description)
+                            (cut string-append "?id=" <>))
+                     "")
+                 "#n" (number->string (location-line loc))))
 
 (define (source-url package)
   (let ((loc (package-location package)))
-- 
2.11.0

Re: [PATCH] website: packages: Anchor location url to commit id.

[Ludovic Courtès]

ericbavier@openmailbox.org skribis:

> From: Eric Bavier <bavier@member.fsf.org>
>
> * website/www/packages.scm (git-description): New variable.
> (location-url): Include "?id=..." if possible.

Looks like a good idea, please push!

Thanks,
Ludo'.

Re: [PATCH] website: packages: Anchor location url to commit id.

[ng0]

On 17-02-13 15:35:25, Ludovic Courtès wrote:
> ericbavier@openmailbox.org skribis:
> 
> > From: Eric Bavier <bavier@member.fsf.org>
> >
> > * website/www/packages.scm (git-description): New variable.
> > (location-url): Include "?id=..." if possible.
> 
> Looks like a good idea, please push!
> 
> Thanks,
> Ludo'.
> 
As a follow-up I think we could also use this now:

(string-append "//git.savannah.gnu.org/cgit/guix.git/tree/"
               (location-file loc) "#n"
               (number->string (location-line loc))))

And the same for other instances of git.savannah.gnu.org,
what do you think?

There are other "http" in the pages which could be replaced with // as
well (for example hydra.gnu.org).

-- 
ng0 -- https://www.inventati.org/patternsinthechaos/

Re: [PATCH] website: packages: Anchor location url to commit id.

[Ludovic Courtès]

ng0 <contact.ng0@cryptolab.net> skribis:

> On 17-02-13 15:35:25, Ludovic Courtès wrote:
>> ericbavier@openmailbox.org skribis:
>> 
>> > From: Eric Bavier <bavier@member.fsf.org>
>> >
>> > * website/www/packages.scm (git-description): New variable.
>> > (location-url): Include "?id=..." if possible.
>> 
>> Looks like a good idea, please push!
>> 
>> Thanks,
>> Ludo'.
>> 
> As a follow-up I think we could also use this now:
>
> (string-append "//git.savannah.gnu.org/cgit/guix.git/tree/"
>                (location-file loc) "#n"
>                (number->string (location-line loc))))
>
> And the same for other instances of git.savannah.gnu.org,
> what do you think?

Good idea.  Done in commit f3ad5e8422b6375029e1526eeb9ea2909b157181 of
guix-artwork.git.

> There are other "http" in the pages which could be replaced with // as
> well (for example hydra.gnu.org).

Don’t hesitate to send a patch if you spot other similar issues.

Thanks!

Ludo’.