From 38b3122afb5093f3094eceb4648f6ff65bd684b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 1 Jun 2012 23:29:55 +0200
Subject: [PATCH] Add `bytevector->base16-string'.

* guix/utils.scm (bytevector->base16-string): New procedure.
---
 guix/utils.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index ad7fe8583f..a5f64f97a9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -17,16 +17,25 @@
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-60)
   #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 format)
   #:use-module ((chop hash)
                 #:select (bytevector-hash
                           hash-method/sha256))
   #:export (bytevector-quintet-length
             bytevector->base32-string
             bytevector->nix-base32-string
+            bytevector->base16-string
             sha256))
 
+
+;;;
+;;; Base 32.
+;;;
+
 (define bytevector-quintet-ref
   (let* ((ref  bytevector-u8-ref)
          (ref+ (lambda (bv offset)
@@ -151,6 +160,35 @@ the previous application or INIT."
 (define bytevector->nix-base32-string
   (make-bytevector->base32-string bytevector-quintet-fold-right
                                   %nix-base32-chars))
+
+
+;;;
+;;; Base 16.
+;;;
+
+(define (bytevector->base16-string bv)
+  "Return the hexadecimal representation of BV's contents."
+  (define len
+    (bytevector-length bv))
+
+  (let-syntax ((base16-chars (lambda (s)
+                               (syntax-case s ()
+                                 (_
+                                  (let ((v (list->vector
+                                            (unfold (cut > <> 255)
+                                                    (lambda (n)
+                                                      (format #f "~2,'0x" n))
+                                                    1+
+                                                    0))))
+                                    v))))))
+    (define chars base16-chars)
+    (let loop ((i 0)
+               (r '()))
+      (if (= i len)
+          (string-concatenate-reverse r)
+          (loop (+ 1 i)
+                (cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))
+
 
 ;;;
 ;;; Hash.