Updating to use PEG for parsing hex (#2)

Reviewed-on: vv/guile-termenv#2
Co-authored-by: Vivianne Langdon <puttabutta@gmail.com>
Co-committed-by: Vivianne Langdon <puttabutta@gmail.com>

termenv/color.scm

@@ -3,6 +3,7 @@
   #:use-module (termenv unix)
   #:use-module (ice-9 format)
   #:use-module (ice-9 i18n)
+  #:use-module (ice-9 peg)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9 gnu)
   #:export (make-foreground
@@ -305,39 +306,30 @@
   (type color-type))
 
 (define* (hex->color hex #:optional (type 'foreground))
-  (define strlen (string-length hex))
-  (define trimmed
-    (cond
-     ((and (or (= strlen 4)
-	             (= strlen 7))
-	         (char=? (string-ref hex 0) #\#))
-      (substring/copy hex 1))
-     ((and (or (= strlen 5)
-	             (= strlen 8))
-	         (char=? (string-ref hex 1) #\x))
-      (substring/copy hex 2))
-     ((or (= strlen 3)
-	        (= strlen 6))
-      hex)
-     (else (error "Invalid hex string: incorrect length"))))
-  (define width (if (= (string-length trimmed) 3) 1 2))
+  (define-peg-pattern hex-char body (peg "[a-fA-F0-9]"))
+  (define-peg-pattern wide all (and hex-char hex-char))
+  (define-peg-pattern narrow all hex-char)
 
-  (define r (locale-string->integer
-	           (substring/copy trimmed 0 width) 16))
-  (define g (locale-string->integer
-	           (substring/copy trimmed width (* 2 width)) 16))
-  (define b (locale-string->integer
-	           (substring/copy trimmed (* 2 width) (* 3 width)) 16))
+  (define-peg-pattern hex-chars body
+    (or (and wide wide wide)
+        (and narrow narrow narrow)))
 
-  (when (= width 1)
-    (let ((double-hex
-	         (lambda (v)
-	           (+ (* v #XF) v))))
-      (set! r (double-hex r))
-      (set! g (double-hex g))
-      (set! b (double-hex b))))
+  (define-peg-pattern hex-string body
+    (and (ignore (and (? "#") (? (or "x" "0x"))))
+         hex-chars))
 
-  (make-color r g b type))
+  (define (terminal->channel term)
+    (let* ((str (second term))
+           (val (locale-string->integer str 16)))
+      ;; If one character we act as if it was doubled
+      (if (= 1 (string-length str))
+          (+ val (* val 16))
+          val)))
+
+  (let* ((tree (peg:tree (match-pattern hex-string hex)))
+         (chs (and tree (map terminal->channel tree))))
+    (and chs
+         (make-color (first chs) (second chs) (third chs) type))))
 
 (define %ANSI256-COLORS
   (map hex->color %ANSI256-HEX))