[bug#45919] [PATCH 2/8] utils: Add 'version-unique-prefix'.

[Ludovic Courtès]

* guix/utils.scm (version-unique-prefix): New procedure.
* tests/utils.scm ("version-unique-prefix"): New test.
---
 guix/utils.scm  | 35 ++++++++++++++++++++++++++++++++++-
 tests/utils.scm |  8 +++++++-
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index f8b05e7e80..a85e2f495c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic 
Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@@ -88,6 +88,7 @@
             version-major+minor+point
             version-major+minor
             version-major
+            version-unique-prefix
             guile-version>?
             version-prefix?
             string-replace-substring
@@ -589,6 +590,38 @@ minor version numbers from version-string."
   "Return the major version number as string from the version-string."
   (version-prefix version-string 1))
 
+(define (version-unique-prefix version versions)
+  "Return the shortest version prefix to unambiguously identify VERSION among
+VERSIONS.  For example:
+
+  (version-unique-prefix \"2.0\" '(\"3.0\" \"2.0\"))
+  => \"2\"
+
+  (version-unique-prefix \"2.2\" '(\"3.0.5\" \"2.0.9\" \"2.2.7\"))
+  => \"2.2\"
+
+  (version-unique-prefix \"27.1\" '(\"27.1\"))
+  => \"\"
+"
+  (define not-dot
+    (char-set-complement (char-set #\.)))
+
+  (define other-versions
+    (delete version versions))
+
+  (let loop ((prefix     '())
+             (components (string-tokenize version not-dot)))
+    (define prefix-str
+      (string-join prefix "."))
+
+    (if (any (cut string-prefix? prefix-str <>) other-versions)
+        (match components
+          ((head . tail)
+           (loop `(,@prefix ,head) tail))
+          (()
+           version))
+        prefix-str)))
+
 (define (version>? a b)
   "Return #t when A denotes a version strictly newer than B."
   (eq? '> (version-compare a b)))
diff --git a/tests/utils.scm b/tests/utils.scm
index 9bce446d98..62ec7e8b4c 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic 
Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
@@ -78,6 +78,12 @@
        (not (version-prefix? "4.1" "4.16.2"))
        (not (version-prefix? "4.1" "4"))))
 
+(test-equal "version-unique-prefix"
+  '("2" "2.2" "")
+  (list (version-unique-prefix "2.0" '("3.0" "2.0"))
+        (version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7"))
+        (version-unique-prefix "27.1" '("27.1"))))
+
 (test-equal "string-tokenize*"
   '(("foo")
     ("foo" "bar" "baz")
-- 
2.30.0