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

Compare commits

base: silasfox:a08efcef9cdc089e4b401247c69efe7783596f92
Branches Tags
silasfox:master
silasfox:v1.0.0
..
compare: silasfox:a3b6fb2b4c2ddefafa877e52b3bf324075e49e6f
Branches Tags
silasfox:master
silasfox:v1.0.0

No commits in common. "a08efcef9cdc089e4b401247c69efe7783596f92" and "a3b6fb2b4c2ddefafa877e52b3bf324075e49e6f" have entirely different histories.
a08efcef9c ... a3b6fb2b4c

10 changed files with 114 additions and 150 deletions
Show Stats Expand all files Collapse all files

37
bible-tools/bible-tools.scm → bible-tools.scm
View File

@ -1,16 +1,28 @@
(define-module (bible-tools bible-tools) (define-module (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 (srfi srfi-171)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:export (book chapter verse text #:export (mapcan
get-book get-chapter get-verse get-bible
call-with-book call-with-chapter string->bible
clean-strings
book
chapter
verse
text
get-book
get-chapter
get-verse
let-bible
call-with-book
call-with-chapter
with-bible with-bible
verse->string clean-strings)) with-book
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"))
@ -20,23 +32,18 @@
(define string->verse (cut string-split <> #\tab)) (define string->verse (cut string-split <> #\tab))
(define clean-strings (define clean-strings
(tfilter (compose not (cut string=? <> "")))) (cut filter (compose not (cut string=? <> "")) <>))
(define string->bible (define string->bible
(compose (compose (cut map string->verse <>)
(cut list-transduce (compose clean-strings (tmap string->verse)) clean-strings
rcons <>) (cut string-split <> #\newline)))
(cut string-split <> #\newline)))
(define book first) (define book first)
(define chapter fourth) (define chapter fourth)
(define verse fifth) (define verse fifth)
(define text sixth) (define text sixth)
(define (verse->string v)
(string-append (book v) " " (chapter v) ":" (verse v)
"\t" (text v)))
(define (get-num query bible part) (define (get-num query bible part)
(filter (compose (cut = query <>) string->number part) bible)) (filter (compose (cut = query <>) string->number part) bible))
(define (get-book book-name bible) (define (get-book book-name bible)

28
bible-tools/count-words.scm
View File

@ -1,32 +1,22 @@
(define-module (bible-tools count-words) (define-module (bible-tools count-words)
#:use-module (bible-tools bible-tools) #:use-module (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-171)
#:use-module (srfi srfi-171 gnu)
#: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 '(#\, #\: #\. #\! #\? #\; #\< #\>))))
(fold mapcan (string-split str #\space) splits))) (clean-strings (fold mapcan (string-split str #\space) splits))))
(define (counter . args)
(cond ((null? args) '())
((< (length args) 2) (car args))
(else (let ((val (assoc (cadr args) (car args))))
(acons (cadr args)
(1+ (if val (cdr val) 0)) (car args))))))
(define (count verse result) (define (count verse result)
(list-transduce clean-strings (fold (lambda (word res)
counter (let ((val (assoc word res)))
result (split/stuff verse))) (acons word (1+ (if val (cdr val) 0)) res)))
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 sort <> (co > cdr)) (compose (cut delete-duplicates <> (co equal? car))
(cut delete-duplicates <> (co equal? car)) (cut sort <> (co > cdr))
(cut fold count '() <>))) (cut fold count '() <>)))

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

@ -1,5 +1,5 @@
(define-module (bible-tools latex-export) (define-module (bible-tools latex-export)
#:use-module (bible-tools bible-tools) #:use-module (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
guix.scm
View File

@ -76,9 +76,7 @@
`(("autoconf" ,autoconf) `(("autoconf" ,autoconf)
("automake" ,automake) ("automake" ,automake)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("texinfo" ,texinfo) ("texinfo" ,texinfo)))
("guile-hall" ,guile-hall)
("guile" ,guile-3.0)))
(inputs `(("guile" ,guile-3.0))) (inputs `(("guile" ,guile-3.0)))
(propagated-inputs `()) (propagated-inputs `())
(synopsis "") (synopsis "")

5
hall.scm
View File

@ -14,14 +14,13 @@
((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
"scripts" "scripts"
((in-file "bible-app") ((in-file "bible-app")
(in-file "search-bible")
(in-file "word-counter") (in-file "word-counter")
(in-file "bible2latex") (in-file "bible2latex")
(in-file "read-bible"))))) (in-file "read-bible")))))

2
scripts/bible-app.in
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 bible-tools) #:use-module (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)

49
scripts/bible2latex.in
View File

@ -1,36 +1,37 @@
#! /usr/bin/env sh #! /usr/bin/env sh
exec guile -e main -s "$0" "$@" exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
!# !#
(use-modules (bible-tools bible-tools) (define-module (bible2latex)
(bible-tools latex-export) #:use-module (bible-tools)
(srfi srfi-1) #:use-module (bible-tools latex-export)
(srfi srfi-26)) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (main))
(define print-text (compose display as-latex))
(define (help) (define (help)
(display "Usage: bible2latex [-b book] [-c chapter]") (display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n")
(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 "bible2latex v1.0.0\n")
(define pr (compose display as-latex))
(define flag? (cut member <> args)) (define flag? (cut member <> args))
(define get (compose cadr flag?)) (define get (compose cadr flag?))
(let-syntax ((conf (define-syntax conf
(syntax-rules (else) (syntax-rules (else)
((_ (f e)... (else g)) (cond ((flag? f) e)... ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
(else g)))))) (with-bible "elb1871"
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871"))) (conf ("-h" (help))
(with-bible bible ("-v" (version))
(conf ("-h" (help)) ("-b" (if (flag? "-c")
("-v" (display version)) (call-with-chapter (get "-b") (get "-c")
("-b" (if (flag? "-c") print-text)
(call-with-chapter (get "-b") (call-with-book (get "-b") print-text)))
(get "-c") pr) (else print-text))))
(call-with-book (get "-b") pr)))
(else pr))))))

49
scripts/read-bible.in
View File

@ -1,10 +1,19 @@
#! /usr/bin/env sh #! /usr/bin/env sh
exec guile -e main -s "$0" "$@" exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
!# !#
(use-modules (bible-tools bible-tools) (define-module (read-bible)
(srfi srfi-1) #:use-module (bible-tools)
(srfi srfi-26)) #: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 (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")
@ -13,22 +22,22 @@ exec guile -e 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 verse->string t)))
(define version "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?))
(let-syntax ((conf (define-syntax conf
(syntax-rules (else) (syntax-rules (else)
((_ (f e)...) (cond ((flag? f) e)... ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
(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" (display version)) ("-v" (version))
("-b" (if (flag? "-c") ("-b" (if (flag? "-c")
(call-with-chapter (get "-b") (call-with-chapter (get "-b") (get "-c")
(get "-c") pr) print-text)
(call-with-book (get "-b") (call-with-book (get "-b") print-text)))
pr)))))))) (else (help))))))

39
scripts/search-bible.in
View File

@ -1,39 +0,0 @@
#! /usr/bin/env sh
exec guile -e main -s "$0" "$@"
!#
(use-modules (bible-tools bible-tools)
(srfi srfi-1)
(srfi srfi-26))
(define (search phrase txt)
(let ((rx (make-regexp phrase regexp/icase)))
(filter (lambda (v) (regexp-exec rx (text v))) txt)))
(define (help)
(display "Usage: search-bible search-phrase [-b book] [-c chapter]")
(display " [-h] [-v] [--bible b]\n")
(display "\t-b book search in this book\n")
(display "\t-c chapter search in this chapter\n")
(display "\t-h display this help message\n")
(display "\t-v display the current version\n")
(display "\t--bible b use this bible\n"))
(define (main args)
(define (pr t)
(map (lambda (str) (display str) (newline))
(map verse->string (search (cadr args) t))))
(define version "search-bible v1.0.0\n")
(define flag? (cut member <> args))
(define get (compose cadr flag?))
(let-syntax ((conf (syntax-rules (else)
((_ (f e)... (else g)) (cond ((flag? f) e)...
(else g))))))
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
(with-bible bible
(conf ("-h" (help)) ("-v" (display version))
("-b" (if (flag? "-c")
(call-with-chapter (get "-b")
(get "-c") pr)
(call-with-book (get "-b") pr)))
(else (if (< 1 (length args)) pr (help))))))))

49
scripts/word-counter.in
View File

@ -1,40 +1,39 @@
#! /usr/bin/env sh #! /usr/bin/env sh
exec guile -e main -s "$0" "$@" exec guile -e '(@ (word-counter) main)' -s "$0" "$@"
!# !#
(use-modules (bible-tools bible-tools) (define-module (word-counter)
(bible-tools count-words) #:use-module (bible-tools)
(srfi srfi-1) #:use-module (bible-tools count-words)
(srfi srfi-26)) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (main))
(define (show t) (define (show-meta txt)
(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 t)))) (for-each (compose display to-str) (count-words (map text txt))))
(define (help) (define (help)
(display "Usage: word-counter [book] [-c chapter]") (display "Usage: count-words [book] [-c chapter] [-h] [-v]\n")
(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 "word-counter v1.0.0\n")
(define flag? (cut member <> args)) (define flag? (cut member <> args))
(define get (compose cadr flag?)) (define get (compose cadr flag?))
(let-syntax ((conf (syntax-rules (else) (define-syntax conf
((_ (f e)... (else g)) (cond ((flag? f) e)... (syntax-rules (else)
(else g)))))) ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871"))) (with-bible "elb1871"
(with-bible bible (conf ("-h" (help))
(conf ("-h" (help)) ("-v" (version))
("-v" (display version)) ("-c"
("-c" (call-with-chapter (cadr args) (get "-c") show-meta))
(call-with-chapter (cadr args) (get "-c") (else (if (< (length args) 2) (help)
show)) (call-with-book (cadr args) show-meta))))))
(else (if (< (length args) 2) (help)
(call-with-book (cadr args)
show))))))))