From ed243c67745a43f9adac93afe070116dbfa6ae1b Mon Sep 17 00:00:00 2001
From: rekado <rekado@elephly.net>
Date: Sat, 1 Oct 2016 18:40:01 +0200
Subject: Validate tunings.

---
 scales/fretboard.scm | 17 ++++++++++++++++-
 scales/ui.scm        | 15 +++++++++++----
 2 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/scales/fretboard.scm b/scales/fretboard.scm
index bda4da7..db91480 100644
--- a/scales/fretboard.scm
+++ b/scales/fretboard.scm
@@ -23,7 +23,9 @@
   #:use-module (srfi srfi-26)
   #:use-module (scales utils)
   #:use-module (scales svg)
-  #:export (tuning-guitar
+  #:export (valid-tunings
+
+            tuning-guitar
             tuning-guitar-d
             tuning-guitar-7
             tuning-bass
@@ -79,6 +81,19 @@
 (define tuning-grand-stick-matched-reciprocal-6+6
   '((b e a d g c) (b e a d g c)))
 
+(define valid-tunings
+  '(guitar
+    guitar-d
+    guitar-7
+    bass
+    bass-5
+    bass-6
+    ukulele
+    ukulele-baritone
+    ukulele-slack
+    ukulele-english
+    grand-stick-matched-reciprocal-6+6))
+
 
 (define-record-type <fret>
   (make-fret position note)
diff --git a/scales/ui.scm b/scales/ui.scm
index 8ddfda6..008b5f6 100644
--- a/scales/ui.scm
+++ b/scales/ui.scm
@@ -23,11 +23,18 @@
   #:export (main))
 
 (define (lookup-tuning tuning)
-  (catch #t
-    (lambda _
+  (if (member tuning valid-tunings)
       (module-ref (resolve-interface '(scales fretboard))
-                  (symbol-append 'tuning- tuning)))
-    (lambda _ tuning)))
+                  (symbol-append 'tuning- tuning))
+      (if (not (pair? tuning))
+          (leave "
+Invalid tuning \"~s\".
+The tuning must be either the name of a pre-defined tuning or a list of steps.
+
+Valid tuning names are:
+
+~{  ~s \n~}\n" tuning valid-tunings)
+          tuning)))
 
 (define (lookup-scale scale)
   (if (member scale valid-scales)
-- 
cgit v1.2.3