04/08: etc: Add 'time-travel-manifest.scm'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit e80f0cda96181d90604c44f69094f2499036b3f6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jul 8 23:31:55 2022 +0200

    etc: Add 'time-travel-manifest.scm'.
    
    This manifest makes it easy to test travels from the current revision
    back to the revision of a past Guix release.
    
    Suggested by zimoun <zimon.toutoune@gmail.com>.
    
    * etc/time-travel-manifest.scm: New file.
    * Makefile.am (EXTRA_DIST): Add it.
---
 Makefile.am                  |  1 +
 etc/time-travel-manifest.scm | 73 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 74 insertions(+)

diff --git a/Makefile.am b/Makefile.am
index 377cac03f7..e5363140fb 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -667,6 +667,7 @@ EXTRA_DIST +=                                               
\
   etc/release-manifest.scm                             \
   etc/source-manifest.scm                              \
   etc/system-tests.scm                                 \
+  etc/time-travel-manifest.scm                         \
   etc/historical-authorizations                                \
   build-aux/build-self.scm                             \
   build-aux/compile-all.scm                            \
diff --git a/etc/time-travel-manifest.scm b/etc/time-travel-manifest.scm
new file mode 100644
index 0000000000..3d7ecff370
--- /dev/null
+++ b/etc/time-travel-manifest.scm
@@ -0,0 +1,73 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; This file returns a manifest containing entries to build past Guix
+;;; releases from the current Guix, as per 'guix time-machine'.
+
+(use-modules (srfi srfi-9) (ice-9 match)
+             (guix channels) (guix gexp))
+
+;; Representation of the latest channels.  This type exists just so we can
+;; refer to such records in a gexp.
+(define-record-type <guix-instance>
+  (guix-instance channels)
+  guix-instance?
+  (channels guix-instance-channels))
+
+(define-gexp-compiler (guix-instance-compiler (instance <guix-instance>)
+                                              system target)
+  (match instance
+    (($ <guix-instance> channels)
+     (latest-channel-derivation channels))))
+
+(define (guix-instance->manifest-entry instance)
+  "Return a manifest entry for INSTANCE."
+  (define (shorten commit)
+    (string-take commit 7))
+
+  (manifest-entry
+    (name "guix")
+    (version (string-join (map (compose shorten channel-commit)
+                               (guix-instance-channels instance))
+                          "-"))
+    (item instance)))
+
+(define (commit->guix-instance commit)
+  "Return a Guix instance for COMMIT."
+  (guix-instance (list (channel
+                        (inherit %default-guix-channel)
+                        (commit commit)))))
+
+(define %release-commits
+  ;; Release commits: the list of version/commit pairs.
+  '(("1.3.0" . "a0178d34f582b50e9bdbb0403943129ae5b560ff")
+    ("1.2.0" . "a099685659b4bfa6b3218f84953cbb7ff9e88063")
+    ("1.1.0" . "d62c9b2671be55ae0305bebfda17b595f33797f2")
+    ("1.0.1" . "d68de958b60426798ed62797ff7c96c327a672ac")
+    ("1.0.0" . "6298c3ffd9654d3231a6f25390b056483e8f407c")
+    ("0.16.0" . "4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c")))
+
+(manifest
+ (map (match-lambda
+        ((version . commit)
+         (let ((entry (guix-instance->manifest-entry
+                       (commit->guix-instance commit))))
+           (manifest-entry
+             (inherit entry)
+             (version version)))))
+      %release-commits))