aboutsummaryrefslogtreecommitdiff
path: root/gnu/gnunet/mq/error-reporting.scm
blob: 41f4f73529841656b9e10275e947e93a0c554cde (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet 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
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later

;; Summary: Reporting errors from message queues.
;;
;; By default, errors are reported to the @code{(current-error-port)},
;; but this is customisable by parameterising
;; @code{textual-error-reporting-port}.
;;
;; For non-textual error reporting, @code{error-reporter} can be parameterised.
;; This library is only for _reporting_ errors.  What happens after reporting,
;; is up to the caller.
(define-library (gnu gnunet mq error-reporting)
  (export format-error-textually
	  report-error-textually
	  textual-error-reporting-port
	  error-reporter
	  report-error)
  (import (only (guile)
		format gettext ngettext current-error-port)
	  (only (srfi srfi-39)
		make-parameter)
	  (only (rnrs base)
		begin define case else apply car if lambda cons))
  (begin
    ;; TODO: set up translations
    (define (G_ message)
      (gettext message "scheme-gnunet"))

    (define (format-message-type type) ; XXX
      type)

    (define (format-error-textually key . arguments)
      "Return a textual representation of the error @code{key . arguments},
translated for the current locale when possible."
      (case key
	((connection:connected)
	 (G_ "the connection to the server has been established"))
	((connection:interrupted)
	 (G_ "the connection has been closed before it could be established"))
	((input:regular-end-of-file)
	 (G_ "the connection has been broken"))
	((input:premature-end-of-file)
	 (G_ "the connection has been broken while there was still some data to read"))
	((input:overly-small)
	 (apply (lambda (type size)
		  (if type
		      (format
		       #f
		       (G_ "a message of type ~a and size ~a was smaller than the minimal message size")
		       (format-message-type type)
		       size)
		      (format
		       #f
		       (G_ "a message of size ~a was smaller than the minimal message size")
		       size)))
		arguments))
	((logic:no-handler)
	 (format
	  #f
	  (G_ "no message handler for ~a was found, but a message of that type was received")
	  (format-message-type (car arguments))))
	((logic:ill-formed)
	 (format
	  #f
	  (G_ "an ill-formed message of type ~a was received")
	  (format-message-type (car arguments))))
	(else
	 (format
	  #f
	  (G_ "an unknown error ‘~s’ was encountered")
	  (cons key arguments)))))

    (define (report-error-textually port key . arguments)
      "Write a textual representation of the error @code{key . arguments} to
the output port @var{port}, translated for the current locale if possible."
      (format port "Scheme-GNUnet: ~a~%"
	      (apply format-error-textually key arguments)))

    (define textual-error-reporting-port
      (make-parameter #f))
      
    (define error-reporter
      (make-parameter
       (lambda (key . arguments)
	 (define t (textual-error-reporting-port))
	 (if t
	     (apply report-error-textually t key arguments)
	     (apply report-error-textually (current-error-port) key arguments)))))

    (define (report-error key . arguments)
      "Report the error @code{key . arguments}."
      (apply (error-reporter) key arguments))))