Refactorings
This commit is contained in:
parent
a3b6fb2b4c
commit
272b4ba2b7
@ -1,28 +1,15 @@
|
||||
(define-module (bible-tools)
|
||||
(define-module (bible-tools bible-tools)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-98)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:export (mapcan
|
||||
get-bible
|
||||
string->bible
|
||||
clean-strings
|
||||
book
|
||||
chapter
|
||||
verse
|
||||
text
|
||||
get-book
|
||||
get-chapter
|
||||
get-verse
|
||||
let-bible
|
||||
call-with-book
|
||||
call-with-chapter
|
||||
#:export (book chapter verse text
|
||||
get-book get-chapter get-verse
|
||||
call-with-book call-with-chapter
|
||||
with-bible
|
||||
with-book
|
||||
with-chapter))
|
||||
clean-strings))
|
||||
|
||||
(define (mapcan f l) (apply append (map f l)))
|
||||
(define make-bible-path
|
||||
(cut string-append (get-environment-variable "HOME")
|
||||
"/.bible/" <> ".tsv"))
|
||||
@ -35,8 +22,7 @@
|
||||
(cut filter (compose not (cut string=? <> "")) <>))
|
||||
|
||||
(define string->bible
|
||||
(compose (cut map string->verse <>)
|
||||
clean-strings
|
||||
(compose (cut map string->verse <>) clean-strings
|
||||
(cut string-split <> #\newline)))
|
||||
|
||||
(define book first)
|
@ -1,10 +1,11 @@
|
||||
(define-module (bible-tools count-words)
|
||||
#:use-module (bible-tools)
|
||||
#:use-module (bible-tools bible-tools)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (count-words))
|
||||
|
||||
(define (split/stuff str)
|
||||
(define (mapcan f l) (apply append (map f l)))
|
||||
(define (split-curry char) (cut string-split <> char))
|
||||
(let ((splits (map split-curry '(#\, #\: #\. #\! #\? #\; #\< #\>))))
|
||||
(clean-strings (fold mapcan (string-split str #\space) splits))))
|
||||
@ -16,6 +17,7 @@
|
||||
result (split/stuff verse)))
|
||||
|
||||
(define (co f g) (lambda (v w) (f (g v) (g w))))
|
||||
|
||||
(define count-words
|
||||
(compose (cut delete-duplicates <> (co equal? car))
|
||||
(cut sort <> (co > cdr))
|
||||
|
@ -1,5 +1,5 @@
|
||||
(define-module (bible-tools latex-export)
|
||||
#:use-module (bible-tools)
|
||||
#:use-module (bible-tools bible-tools)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (as-latex))
|
||||
|
4
hall.scm
4
hall.scm
@ -14,8 +14,8 @@
|
||||
((directory
|
||||
"bible-tools"
|
||||
((scheme-file "latex-export")
|
||||
(scheme-file "count-words")))
|
||||
(scheme-file "bible-tools")))
|
||||
(scheme-file "count-words")
|
||||
(scheme-file "bible-tools")))))
|
||||
(tests ((directory "tests" ())))
|
||||
(programs
|
||||
((directory
|
||||
|
@ -3,7 +3,7 @@ exec guile -e '(@ (bible-app) main)' -s "$0" "$@"
|
||||
!#
|
||||
|
||||
(define-module (bible-app)
|
||||
#:use-module (bible-tools)
|
||||
#:use-module (bible-tools bible-tools)
|
||||
#:use-module (bible-tools latex-export)
|
||||
#:use-module (bible-tools count-words)
|
||||
#:use-module (srfi srfi-1)
|
||||
|
@ -9,29 +9,29 @@ exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (main))
|
||||
|
||||
(define print-text (compose display as-latex))
|
||||
|
||||
(define (help)
|
||||
(display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n")
|
||||
(display "Usage: bible2latex [-b book] [-c chapter]")
|
||||
(display "[-h] [-v] [--bible b]\n")
|
||||
(display "\t-b book\t\texport the book to latex\n")
|
||||
(display "\t-c chapter\texport this chapter to latex\n")
|
||||
(display "\t-h\t\tdisplay this help message\n")
|
||||
(display "\t-v\t\tdisplay the current version\n"))
|
||||
|
||||
(define (version)
|
||||
(display "bible2latex v1.0.0\n"))
|
||||
(display "\t-v\t\tdisplay the current version\n")
|
||||
(display "\t--bible b use this bible\n"))
|
||||
|
||||
(define (main args)
|
||||
(define version (cut display "bible2latex v1.0.0\n"))
|
||||
(define print (compose display as-latex))
|
||||
(define flag? (cut member <> args))
|
||||
(define get (compose cadr flag?))
|
||||
(define-syntax conf
|
||||
(syntax-rules (else)
|
||||
((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
|
||||
(with-bible "elb1871"
|
||||
(conf ("-h" (help))
|
||||
("-v" (version))
|
||||
("-b" (if (flag? "-c")
|
||||
(call-with-chapter (get "-b") (get "-c")
|
||||
print-text)
|
||||
(call-with-book (get "-b") print-text)))
|
||||
(else print-text))))
|
||||
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
|
||||
(with-bible bible
|
||||
(conf ("-h" (help))
|
||||
("-v" (version))
|
||||
("-b" (if (flag? "-c")
|
||||
(call-with-chapter (get "-b")
|
||||
(get "-c") print)
|
||||
(call-with-book (get "-b") print)))
|
||||
(else print)))))
|
||||
|
@ -3,17 +3,14 @@ exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
|
||||
!#
|
||||
|
||||
(define-module (read-bible)
|
||||
#:use-module (bible-tools)
|
||||
#:use-module (bible-tools bible-tools)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (main))
|
||||
|
||||
(define (verse->string v)
|
||||
(string-append (book v) " " (chapter v) ":" (verse v) "\t" (text v)))
|
||||
|
||||
(define (print-text txt)
|
||||
(for-each (lambda (str) (display str) (newline))
|
||||
(map verse->string txt)))
|
||||
(define (v->str v)
|
||||
(string-append (book v) " " (chapter v) ":" (verse v)
|
||||
"\t" (text v)))
|
||||
|
||||
(define (help)
|
||||
(display "Usage: read-bible bible [-b book] [-c chapter] [-h] [-v]\n")
|
||||
@ -22,22 +19,21 @@ exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
|
||||
(display "\t-h\t\tdisplay this help message\n")
|
||||
(display "\t-v\t\tdisplay the current version\n"))
|
||||
|
||||
(define (version)
|
||||
(display "read-bible v1.0.0\n"))
|
||||
|
||||
(define (main args)
|
||||
(define (pr t)
|
||||
(map (lambda (str) (display str) (newline)) (map v->str t)))
|
||||
(define version (cut display "read-bible v1.0.0\n"))
|
||||
(define flag? (cut member <> args))
|
||||
(define get (compose cadr flag?))
|
||||
(define-syntax conf
|
||||
(syntax-rules (else)
|
||||
((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
|
||||
((_ (f e)...) (cond ((flag? f) e)... (else (help))))))
|
||||
(if (< (length args) 2)
|
||||
(help)
|
||||
(with-bible (cadr args)
|
||||
(conf ("-h" (help))
|
||||
("-v" (version))
|
||||
("-b" (if (flag? "-c")
|
||||
(call-with-chapter (get "-b") (get "-c")
|
||||
print-text)
|
||||
(call-with-book (get "-b") print-text)))
|
||||
(else (help))))))
|
||||
(call-with-chapter (get "-b")
|
||||
(get "-c") pr)
|
||||
(call-with-book (get "-b") pr)))))))
|
||||
|
@ -3,37 +3,38 @@ exec guile -e '(@ (word-counter) main)' -s "$0" "$@"
|
||||
!#
|
||||
|
||||
(define-module (word-counter)
|
||||
#:use-module (bible-tools)
|
||||
#:use-module (bible-tools bible-tools)
|
||||
#:use-module (bible-tools count-words)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (main))
|
||||
|
||||
(define (show-meta txt)
|
||||
(define (show t)
|
||||
(define (tabs w) (if (< (string-length (car w)) 7) "\t\t" "\t"))
|
||||
(define (to-str w) (string-append (car w) ":" (tabs w)
|
||||
(number->string (cdr w)) "\n"))
|
||||
(for-each (compose display to-str) (count-words (map text txt))))
|
||||
(for-each (compose display to-str) (count-words (map text t))))
|
||||
|
||||
(define (help)
|
||||
(display "Usage: count-words [book] [-c chapter] [-h] [-v]\n")
|
||||
(display "Usage: word-counter [book] [-c chapter]")
|
||||
(display "[-h] [-v] [--bible b]\n")
|
||||
(display "\t-c chapter count the words in this chapter\n")
|
||||
(display "\t-h display this help message\n")
|
||||
(display "\t-v display the current version\n"))
|
||||
|
||||
(define (version)
|
||||
(display "count-words v1.0.0\n"))
|
||||
(display "\t-v display the current version\n")
|
||||
(display "\t--bible b use this bible\n"))
|
||||
|
||||
(define (main args)
|
||||
(define version (cut display "count-words v1.0.0\n"))
|
||||
(define flag? (cut member <> args))
|
||||
(define get (compose cadr flag?))
|
||||
(define-syntax conf
|
||||
(syntax-rules (else)
|
||||
((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
|
||||
(with-bible "elb1871"
|
||||
(conf ("-h" (help))
|
||||
("-v" (version))
|
||||
("-c"
|
||||
(call-with-chapter (cadr args) (get "-c") show-meta))
|
||||
(else (if (< (length args) 2) (help)
|
||||
(call-with-book (cadr args) show-meta))))))
|
||||
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
|
||||
(with-bible bible
|
||||
(conf ("-h" (help))
|
||||
("-v" (version))
|
||||
("-c"
|
||||
(call-with-chapter (cadr args) (get "-c") show))
|
||||
(else (if (< (length args) 2) (help)
|
||||
(call-with-book (cadr args) show)))))))
|
||||
|
Loading…
x
Reference in New Issue
Block a user