01/09: utils: Move <location> and '&error-location' to (guix diagnostics).

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit a5e2fc73760a2ae023f2e56bdbf8025971f90e64
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jul 24 22:58:08 2020 +0200

    utils: Move <location> and '&error-location' to (guix diagnostics).
    
    * guix/utils.scm (<location>, source-properties->location)
    (location->source-properties, &error-location): Move to...
    * guix/diagnostics.scm: ... here.
    * gnu.scm: Adjust imports accordingly.
    * gnu/machine.scm: Likewise.
    * gnu/system.scm: Likewise.
    * gnu/tests.scm: Likewise.
    * guix/inferior.scm: Likewise.
    * tests/channels.scm: Likewise.
    * tests/packages.scm: Likewise.
---
 gnu.scm              |  5 ++--
 gnu/machine.scm      |  2 +-
 gnu/system.scm       |  5 ++--
 gnu/tests.scm        |  2 +-
 guix/diagnostics.scm | 60 ++++++++++++++++++++++++++++++++++++++++++--
 guix/inferior.scm    |  3 ++-
 guix/utils.scm       | 71 +++++++++++-----------------------------------------
 tests/channels.scm   |  2 +-
 tests/packages.scm   |  3 ++-
 9 files changed, 86 insertions(+), 67 deletions(-)

diff --git a/gnu.scm b/gnu.scm
index 2c29b6d..5f593bd 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès 
<ludo@gnu.org>
 ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
@@ -20,7 +20,8 @@
 
 (define-module (gnu)
   #:use-module (guix i18n)
-  #:use-module (guix utils)
+  #:use-module ((guix utils) #:select (&fix-hint))
+  #:use-module (guix diagnostics)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
diff --git a/gnu/machine.scm b/gnu/machine.scm
index 434d78a..667a988 100644
--- a/gnu/machine.scm
+++ b/gnu/machine.scm
@@ -23,7 +23,7 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix store)
-  #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix diagnostics) #:select (source-properties->location))
   #:use-module (srfi srfi-35)
   #:export (environment-type
             environment-type?
diff --git a/gnu/system.scm b/gnu/system.scm
index de5f25a..6ae15ab 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -35,8 +35,9 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix profiles)
-  #:use-module (guix ui)
-  #:use-module (guix utils)
+  #:use-module ((guix utils) #:select (substitute-keyword-arguments))
+  #:use-module (guix i18n)
+  #:use-module (guix diagnostics)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages cross-base)
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 705bf56..83528a4 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -20,7 +20,7 @@
 
 (define-module (gnu tests)
   #:use-module (guix gexp)
-  #:use-module (guix utils)
+  #:use-module (guix diagnostics)
   #:use-module (guix records)
   #:use-module ((guix ui) #:select (warn-about-load-error))
   #:use-module (gnu bootloader)
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 6c0753a..8b24b1b 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic 
Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,8 +19,9 @@
 (define-module (guix diagnostics)
   #:use-module (guix colors)
   #:use-module (guix i18n)
-  #:autoload   (guix utils) (<location>)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (warning
@@ -28,8 +29,20 @@
             report-error
             leave
 
+            <location>
+            location
+            location?
+            location-file
+            location-line
+            location-column
+            source-properties->location
+            location->source-properties
             location->string
 
+            &error-location
+            error-location?
+            error-location
+
             guix-warning-port
             program-name))
 
@@ -162,6 +175,45 @@ messages."
                 (program-name) (program-name)
                 (prefix-color prefix)))))
 
+
+;; A source location.
+(define-record-type <location>
+  (make-location file line column)
+  location?
+  (file          location-file)                   ; file name
+  (line          location-line)                   ; 1-indexed line
+  (column        location-column))                ; 0-indexed column
+
+(define (location file line column)
+  "Return the <location> object for the given FILE, LINE, and COLUMN."
+  (and line column file
+       (make-location file line column)))
+
+(define (source-properties->location loc)
+  "Return a location object based on the info in LOC, an alist as returned
+by Guile's `source-properties', `frame-source', `current-source-location',
+etc."
+  ;; In accordance with the GCS, start line and column numbers at 1.  Note
+  ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
+  (match loc
+    ((('line . line) ('column . col) ('filename . file)) ;common case
+     (and file line col
+          (make-location file (+ line 1) col)))
+    (#f
+     #f)
+    (_
+     (let ((file (assq-ref loc 'filename))
+           (line (assq-ref loc 'line))
+           (col  (assq-ref loc 'column)))
+       (location file (and line (+ line 1)) col)))))
+
+(define (location->source-properties loc)
+  "Return the source property association list based on the info in LOC,
+a location object."
+  `((line     . ,(and=> (location-line loc) 1-))
+    (column   . ,(location-column loc))
+    (filename . ,(location-file loc))))
+
 (define (location->string loc)
   "Return a human-friendly, GNU-standard representation of LOC."
   (match loc
@@ -169,6 +221,10 @@ messages."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
+(define-condition-type &error-location &error
+  error-location?
+  (location  error-location))                     ;<location>
+
 
 (define guix-warning-port
   (make-parameter (current-warning-port)))
diff --git a/guix/inferior.scm b/guix/inferior.scm
index d347754..7782087 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -21,9 +21,10 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module ((guix diagnostics)
+                #:select (source-properties->location))
   #:use-module ((guix utils)
                 #:select (%current-system
-                          source-properties->location
                           call-with-temporary-directory
                           version>? version-prefix?
                           cache-directory))
diff --git a/guix/utils.scm b/guix/utils.scm
index 17a9637..64894ec 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -37,13 +37,27 @@
   #:use-module (guix memoization)
   #:use-module ((guix build utils) #:select (dump-port mkdir-p 
delete-file-recursively))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
+  #:use-module (guix diagnostics)           ;<location>, &error-location, etc.
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (system foreign)
-  #:re-export (memoize)         ; for backwards compatibility
+  #:re-export (memoize                            ;for backwards compatibility
+
+               <location>
+               location
+               location?
+               location-file
+               location-line
+               location-column
+               source-properties->location
+               location->source-properties
+
+               &error-location
+               error-location?
+               error-location)
   #:export (strip-keyword-arguments
             default-keyword-arguments
             substitute-keyword-arguments
@@ -51,19 +65,6 @@
 
             current-source-directory
 
-            <location>
-            location
-            location?
-            location-file
-            location-line
-            location-column
-            source-properties->location
-            location->source-properties
-
-            &error-location
-            error-location?
-            error-location
-
             &fix-hint
             fix-hint?
             condition-fix-hint
@@ -834,48 +835,6 @@ be determined."
           ;; raising an error would upset Geiser users
           #f))))))
 
-;; A source location.
-(define-record-type <location>
-  (make-location file line column)
-  location?
-  (file          location-file)                   ; file name
-  (line          location-line)                   ; 1-indexed line
-  (column        location-column))                ; 0-indexed column
-
-(define (location file line column)
-  "Return the <location> object for the given FILE, LINE, and COLUMN."
-  (and line column file
-       (make-location file line column)))
-
-(define (source-properties->location loc)
-  "Return a location object based on the info in LOC, an alist as returned
-by Guile's `source-properties', `frame-source', `current-source-location',
-etc."
-  ;; In accordance with the GCS, start line and column numbers at 1.  Note
-  ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
-  (match loc
-    ((('line . line) ('column . col) ('filename . file)) ;common case
-     (and file line col
-          (make-location file (+ line 1) col)))
-    (#f
-     #f)
-    (_
-     (let ((file (assq-ref loc 'filename))
-           (line (assq-ref loc 'line))
-           (col  (assq-ref loc 'column)))
-       (location file (and line (+ line 1)) col)))))
-
-(define (location->source-properties loc)
-  "Return the source property association list based on the info in LOC,
-a location object."
-  `((line     . ,(and=> (location-line loc) 1-))
-    (column   . ,(location-column loc))
-    (filename . ,(location-file loc))))
-
-(define-condition-type &error-location &error
-  error-location?
-  (location  error-location))                     ;<location>
-
 (define-condition-type &fix-hint &condition
   fix-hint?
   (hint condition-fix-hint))                      ;string
diff --git a/tests/channels.scm b/tests/channels.scm
index cde3b66..55a0537 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -26,7 +26,7 @@
   #:use-module (guix derivations)
   #:use-module (guix sets)
   #:use-module (guix gexp)
-  #:use-module ((guix utils)
+  #:use-module ((guix diagnostics)
                 #:select (error-location? error-location location-line))
   #:use-module ((guix build utils) #:select (which))
   #:use-module (git)
diff --git a/tests/packages.scm b/tests/packages.scm
index 6aa3617..0a4bf83 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -23,7 +23,8 @@
   #:use-module (guix monads)
   #:use-module (guix grafts)
   #:use-module ((guix gexp) #:select (local-file local-file-file))
-  #:use-module ((guix utils)
+  #:use-module (guix utils)
+  #:use-module ((guix diagnostics)
                 ;; Rename the 'location' binding to allow proper syntax
                 ;; matching when setting the 'location' field of a package.
                 #:renamer (lambda (name)