silasfox
/
bible-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases 1 Wiki Activity
Browse Source

Refactorings

master
Silas Vedder 2 years ago
parent
a3b6fb2b4c
commit
272b4ba2b7
8 changed files with 55 additions and 70 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 26
      bible-tools/bible-tools.scm
  2. 4
      bible-tools/count-words.scm
  3. 2
      bible-tools/latex-export.scm
  4. 4
      hall.scm
  5. 2
      scripts/bible-app.in
  6. 24
      scripts/bible2latex.in
  7. 26
      scripts/read-bible.in
  8. 23
      scripts/word-counter.in

26
bible-tools.scm → bible-tools/bible-tools.scm
Unescape View File

@ -1,28 +1,15 @@
(define-module (bible-tools) (define-module (bible-tools bible-tools)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-98) #:use-module (srfi srfi-98)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:export (mapcan #:export (book chapter verse text
get-bible get-book get-chapter get-verse
string->bible call-with-book call-with-chapter
clean-strings
book
chapter
verse
text
get-book
get-chapter
get-verse
let-bible
call-with-book
call-with-chapter
with-bible with-bible
with-book clean-strings))
with-chapter))
(define (mapcan f l) (apply append (map f l)))
(define make-bible-path (define make-bible-path
(cut string-append (get-environment-variable "HOME") (cut string-append (get-environment-variable "HOME")
"/.bible/" <> ".tsv")) "/.bible/" <> ".tsv"))
@ -35,8 +22,7 @@
(cut filter (compose not (cut string=? <> "")) <>)) (cut filter (compose not (cut string=? <> "")) <>))
(define string->bible (define string->bible
(compose (cut map string->verse <>) (compose (cut map string->verse <>) clean-strings
clean-strings
(cut string-split <> #\newline))) (cut string-split <> #\newline)))
(define book first) (define book first)

4
bible-tools/count-words.scm
Unescape View File

@ -1,10 +1,11 @@
(define-module (bible-tools count-words) (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-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (count-words)) #:export (count-words))
(define (split/stuff str) (define (split/stuff str)
(define (mapcan f l) (apply append (map f l)))
(define (split-curry char) (cut string-split <> char)) (define (split-curry char) (cut string-split <> char))
(let ((splits (map split-curry '(#\, #\: #\. #\! #\? #\; #\< #\>)))) (let ((splits (map split-curry '(#\, #\: #\. #\! #\? #\; #\< #\>))))
(clean-strings (fold mapcan (string-split str #\space) splits)))) (clean-strings (fold mapcan (string-split str #\space) splits))))
@ -16,6 +17,7 @@
result (split/stuff verse))) result (split/stuff verse)))
(define (co f g) (lambda (v w) (f (g v) (g w)))) (define (co f g) (lambda (v w) (f (g v) (g w))))
(define count-words (define count-words
(compose (cut delete-duplicates <> (co equal? car)) (compose (cut delete-duplicates <> (co equal? car))
(cut sort <> (co > cdr)) (cut sort <> (co > cdr))

2
bible-tools/latex-export.scm
Unescape View File

@ -1,5 +1,5 @@
(define-module (bible-tools latex-export) (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-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (as-latex)) #:export (as-latex))

4
hall.scm
Unescape View File

@ -14,8 +14,8 @@
((directory ((directory
"bible-tools" "bible-tools"
((scheme-file "latex-export") ((scheme-file "latex-export")
(scheme-file "count-words"))) (scheme-file "count-words")
(scheme-file "bible-tools"))) (scheme-file "bible-tools")))))
(tests ((directory "tests" ()))) (tests ((directory "tests" ())))
(programs (programs
((directory ((directory

2
scripts/bible-app.in
Unescape View File

@ -3,7 +3,7 @@ exec guile -e '(@ (bible-app) main)' -s "$0" "$@"
!# !#
(define-module (bible-app) (define-module (bible-app)
#:use-module (bible-tools) #:use-module (bible-tools bible-tools)
#:use-module (bible-tools latex-export) #:use-module (bible-tools latex-export)
#:use-module (bible-tools count-words) #:use-module (bible-tools count-words)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

24
scripts/bible2latex.in
Unescape View File

@ -9,29 +9,29 @@ exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (main)) #:export (main))
(define print-text (compose display as-latex))
(define (help) (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-b book\t\texport the book to latex\n")
(display "\t-c chapter\texport this chapter to latex\n") (display "\t-c chapter\texport this chapter to latex\n")
(display "\t-h\t\tdisplay this help message\n") (display "\t-h\t\tdisplay this help message\n")
(display "\t-v\t\tdisplay the current version\n")) (display "\t-v\t\tdisplay the current version\n")
(display "\t--bible b use this bible\n"))
(define (version)
(display "bible2latex v1.0.0\n"))
(define (main args) (define (main args)
(define version (cut display "bible2latex v1.0.0\n"))
(define print (compose display as-latex))
(define flag? (cut member <> args)) (define flag? (cut member <> args))
(define get (compose cadr flag?)) (define get (compose cadr flag?))
(define-syntax conf (define-syntax conf
(syntax-rules (else) (syntax-rules (else)
((_ (f e)... (else g)) (cond ((flag? f) e)... (else g))))) ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
(with-bible "elb1871" (let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
(with-bible bible
(conf ("-h" (help)) (conf ("-h" (help))
("-v" (version)) ("-v" (version))
("-b" (if (flag? "-c") ("-b" (if (flag? "-c")
(call-with-chapter (get "-b") (get "-c") (call-with-chapter (get "-b")
print-text) (get "-c") print)
(call-with-book (get "-b") print-text))) (call-with-book (get "-b") print)))
(else print-text)))) (else print)))))

26
scripts/read-bible.in
Unescape View File

@ -3,17 +3,14 @@ exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
!# !#
(define-module (read-bible) (define-module (read-bible)
#:use-module (bible-tools) #:use-module (bible-tools bible-tools)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (main)) #:export (main))
(define (verse->string v) (define (v->str v)
(string-append (book v) " " (chapter v) ":" (verse v) "\t" (text 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 (help) (define (help)
(display "Usage: read-bible bible [-b book] [-c chapter] [-h] [-v]\n") (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-h\t\tdisplay this help message\n")
(display "\t-v\t\tdisplay the current version\n")) (display "\t-v\t\tdisplay the current version\n"))
(define (version)
(display "read-bible v1.0.0\n"))
(define (main args) (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 flag? (cut member <> args))
(define get (compose cadr flag?)) (define get (compose cadr flag?))
(define-syntax conf (define-syntax conf
(syntax-rules (else) (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) (if (< (length args) 2)
(help) (help)
(with-bible (cadr args) (with-bible (cadr args)
(conf ("-h" (help)) (conf ("-h" (help))
("-v" (version)) ("-v" (version))
("-b" (if (flag? "-c") ("-b" (if (flag? "-c")
(call-with-chapter (get "-b") (get "-c") (call-with-chapter (get "-b")
print-text) (get "-c") pr)
(call-with-book (get "-b") print-text))) (call-with-book (get "-b") pr)))))))
(else (help))))))

23
scripts/word-counter.in
Unescape View File

@ -3,37 +3,38 @@ exec guile -e '(@ (word-counter) main)' -s "$0" "$@"
!# !#
(define-module (word-counter) (define-module (word-counter)
#:use-module (bible-tools) #:use-module (bible-tools bible-tools)
#:use-module (bible-tools count-words) #:use-module (bible-tools count-words)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (main)) #:export (main))
(define (show-meta txt) (define (show t)
(define (tabs w) (if (< (string-length (car w)) 7) "\t\t" "\t")) (define (tabs w) (if (< (string-length (car w)) 7) "\t\t" "\t"))
(define (to-str w) (string-append (car w) ":" (tabs w) (define (to-str w) (string-append (car w) ":" (tabs w)
(number->string (cdr w)) "\n")) (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) (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-c chapter count the words in this chapter\n")
(display "\t-h display this help message\n") (display "\t-h display this help message\n")
(display "\t-v display the current version\n")) (display "\t-v display the current version\n")
(display "\t--bible b use this bible\n"))
(define (version)
(display "count-words v1.0.0\n"))
(define (main args) (define (main args)
(define version (cut display "count-words v1.0.0\n"))
(define flag? (cut member <> args)) (define flag? (cut member <> args))
(define get (compose cadr flag?)) (define get (compose cadr flag?))
(define-syntax conf (define-syntax conf
(syntax-rules (else) (syntax-rules (else)
((_ (f e)... (else g)) (cond ((flag? f) e)... (else g))))) ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
(with-bible "elb1871" (let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
(with-bible bible
(conf ("-h" (help)) (conf ("-h" (help))
("-v" (version)) ("-v" (version))
("-c" ("-c"
(call-with-chapter (cadr args) (get "-c") show-meta)) (call-with-chapter (cadr args) (get "-c") show))
(else (if (< (length args) 2) (help) (else (if (< (length args) 2) (help)
(call-with-book (cadr args) show-meta)))))) (call-with-book (cadr args) show)))))))

Write Preview
Loading…
Cancel
Save