From e53177872311a012e7626f58e24029e63d8fd07c Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Sun, 25 Sep 2022 17:16:22 +0300
Subject: [PATCH] Refactor

---
 translate.scm | 81 ++++++++++++++++++++++++++-------------------------
 1 file changed, 42 insertions(+), 39 deletions(-)

diff --git a/translate.scm b/translate.scm
index adf6512..5bf9fe5 100644
--- a/translate.scm
+++ b/translate.scm
@@ -5,11 +5,9 @@
 (define rest cdr)
 
 (define (string-join list delimiter)
-  (if (null? list)
-      ""
-      (fold (lambda (item result) (string-append result delimiter item))
-            (first list)
-            (rest list))))
+  (fold (lambda (item result) (string-append result delimiter item))
+        (first list)
+        (rest list)))
 
 (define (capitalize str)
   (string-append (string (ascii-upcase (string-ref str 0)))
@@ -44,31 +42,30 @@
         (cons (string-copy str a b) words)
         words))
   (let loop ((a 0) (b 0) (words '()))
-    (cond ((= b (string-length str))
-           (reverse (eject a b words)))
-          (else
-           (let* ((char (string-ref str b))
-                  (name* (assoc char names))
-                  (name (and name* (second name*))))
-             (cond ((and (char=? #\- char)
-                         (< b (- (string-length str) 1)))
-                    (loop (+ b 1)
-                          (+ b 1)
-                          (eject a b words)))
-                   ((and (char=? #\> char)
-                         (not (null? words))
-                         (= a b))
-                    (loop (+ b 1)
-                          (+ b 1)
-                          (cons "to" words)))
-                   (name
-                    (loop (+ b 1)
-                          (+ b 1)
-                          (cons name (eject a b words))))
-                   ((ascii-alphanumeric? char)
-                    (loop a (+ b 1) words))
-                   (else
-                    (error "What?" char))))))))
+    (if (= b (string-length str))
+        (reverse (eject a b words))
+        (let* ((char (string-ref str b))
+               (name* (assoc char names))
+               (name (and name* (second name*))))
+          (cond ((and (char=? #\- char)
+                      (< b (- (string-length str) 1)))
+                 (loop (+ b 1)
+                       (+ b 1)
+                       (eject a b words)))
+                ((and (char=? #\> char)
+                      (not (null? words))
+                      (= a b))
+                 (loop (+ b 1)
+                       (+ b 1)
+                       (cons "to" words)))
+                (name
+                 (loop (+ b 1)
+                       (+ b 1)
+                       (cons name (eject a b words))))
+                ((ascii-alphanumeric? char)
+                 (loop a (+ b 1) words))
+                (else
+                 (error "What?" char)))))))
 
 (define (translate-camel str)
   (string-join (map capitalize (translate-words str))
@@ -89,19 +86,25 @@
   (write-string file)
   (newline))
 
+(define (write-two-column-list list1 list2)
+  (let ((width (fold max 0 (map string-length list1))))
+    (for-each (lambda (item1 item2)
+                (let ((pad (max 0 (- width (string-length item1)))))
+                  (write-string item1)
+                  (write-string (make-string (+ pad 2) #\space))
+                  (write-string item2)
+                  (newline)))
+              list1
+              list2)))
+
 (define (process translate from-file to-file)
-  (let* ((lines (with-input-from-file from-file read-all-lines))
-         (width (fold max 0 (map string-length lines))))
+  (let* ((source-lines (with-input-from-file from-file read-all-lines))
+         (target-lines (map translate source-lines)))
     (writing to-file)
     (with-output-to-file to-file
       (lambda ()
-        (for-each (lambda (line)
-                    (let ((pad (max 0 (- width (string-length line)))))
-                      (write-string line)
-                      (write-string (make-string (+ pad 2) #\space))
-                      (write-string (translate line))
-                      (newline)))
-                  lines)))))
+        (write-two-column-list source-lines
+                               target-lines)))))
 
 (define (main)
   (define sa string-append)