Refactor
This commit is contained in:
parent
2e98664072
commit
e531778723
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue