gnu: r-qtl2: Move to (gnu packages cran).

[jackhill/guix/guix.git] / guix / base32.scm

diff --git a/guix/base32.scm b/guix/base32.scm
index 6f0a92b..49f191b 100644 (file)
--- a/guix/base32.scm
+++ b/guix/base32.scm
@@ -1,23 +1,25 @@
-;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
 ;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; 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.
 ;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; 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 Guix.  If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix base32)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-60)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 vlist)
@@ -25,7 +27,13 @@
             bytevector->base32-string
             bytevector->nix-base32-string
             base32-string->bytevector
-            nix-base32-string->bytevector))
+            nix-base32-string->bytevector
+            %nix-base32-charset
+            %rfc4648-base32-charset
+            &invalid-base32-character
+            invalid-base32-character?
+            invalid-base32-character-value
+            invalid-base32-character-string))
 
 ;;; Commentary:
 ;;;
@@ -146,11 +154,17 @@ the previous application or INIT."
     #\a #\b #\c #\d #\f #\g #\h #\i #\j #\k #\l #\m #\n
     #\p #\q #\r #\s #\v #\w #\x #\y #\z))
 
+(define %nix-base32-charset
+  (list->char-set (vector->list %nix-base32-chars)))
+
 (define %rfc4648-base32-chars
   #(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
     #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
     #\2 #\3 #\4 #\5 #\6 #\7))
 
+(define %rfc4648-base32-charset
+  (list->char-set (vector->list %rfc4648-base32-chars)))
+
 (define bytevector->base32-string
   (make-bytevector->base32-string bytevector-quintet-fold
                                   %rfc4648-base32-chars))
@@ -264,6 +278,12 @@ starting from the right of S."
                        s)
     bv))
 
+;; Invalid base32 character error condition when decoding base32.
+(define-condition-type &invalid-base32-character &error
+  invalid-base32-character?
+  (character invalid-base32-character-value)
+  (string    invalid-base32-character-string))
+
 (define (make-base32-string->bytevector base32-string-unfold base32-chars)
   (let ((char->value (let loop ((i 0)
                                 (v vlist-null))
@@ -276,7 +296,10 @@ starting from the right of S."
       "Return the binary representation of base32 string S as a bytevector."
       (base32-string-unfold (lambda (chr)
                               (or (and=> (vhash-assv chr char->value) cdr)
-                                  (error "invalid base32 character" chr)))
+                                  (raise (condition
+                                          (&invalid-base32-character
+                                           (character chr)
+                                           (string s))))))
                             s))))
 
 (define base32-string->bytevector