aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-07-24 22:58:08 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-25 19:11:36 +0200
commita5e2fc73760a2ae023f2e56bdbf8025971f90e64 (patch)
tree2933826e391a889723e1db12699c74a845b7c4c5
parent07dbdbd766760ce0121c1ac96fee766135fe7320 (diff)
downloadguix-a5e2fc73760a2ae023f2e56bdbf8025971f90e64.tar
guix-a5e2fc73760a2ae023f2e56bdbf8025971f90e64.tar.gz
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.
-rw-r--r--gnu.scm5
-rw-r--r--gnu/machine.scm2
-rw-r--r--gnu/system.scm5
-rw-r--r--gnu/tests.scm2
-rw-r--r--guix/diagnostics.scm60
-rw-r--r--guix/inferior.scm3
-rw-r--r--guix/utils.scm71
-rw-r--r--tests/channels.scm2
-rw-r--r--tests/packages.scm3
9 files changed, 86 insertions, 67 deletions
diff --git a/gnu.scm b/gnu.scm
index 2c29b6dc3f..5f593bd569 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 434d78ab41..667a988f99 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 de5f25a35d..6ae15ab23b 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 705bf561a6..83528a40f0 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 6c0753aef4..8b24b1b994 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 d347754bbc..77820872b3 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 17a96370f1..64894ecf1f 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 cde3b668fb..55a0537e0f 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 6aa36170d2..0a4bf83c40 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)