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

A lot of changes

Browse Source
This commit is contained in:
Silas Vedder 2022-11-11 12:29:21 +01:00
parent 272b4ba2b7
commit a08efcef9c
Signed by: silasfox
GPG Key ID: 10DFF4A1DB187699
8 changed files with 130 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
bible-tools/bible-tools.scm
View File

@ -2,13 +2,14 @@
#: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 (book chapter verse text
get-book get-chapter get-verse get-book get-chapter get-verse
call-with-book call-with-chapter call-with-book call-with-chapter
with-bible with-bible
clean-strings)) verse->string clean-strings))
(define make-bible-path (define make-bible-path
(cut string-append (get-environment-variable "HOME") (cut string-append (get-environment-variable "HOME")
@ -19,17 +20,23 @@
(define string->verse (cut string-split <> #\tab)) (define string->verse (cut string-split <> #\tab))
(define clean-strings (define clean-strings
(cut filter (compose not (cut string=? <> "")) <>)) (tfilter (compose not (cut string=? <> ""))))
(define string->bible (define string->bible
(compose (cut map string->verse <>) clean-strings (compose
(cut string-split <> #\newline))) (cut list-transduce (compose clean-strings (tmap string->verse))
rcons <>)
(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)

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

@ -2,23 +2,31 @@
#:use-module (bible-tools 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)
#: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 (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)))) (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)
(fold (lambda (word res) (list-transduce clean-strings
(let ((val (assoc word res))) counter
(acons word (1+ (if val (cdr val) 0)) res))) 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 sort <> (co > cdr))
(cut sort <> (co > cdr)) (cut delete-duplicates <> (co equal? car))
(cut fold count '() <>))) (cut fold count '() <>)))

4
guix.scm
View File

@ -76,7 +76,9 @@
`(("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 "")

1
hall.scm
View File

@ -21,6 +21,7 @@
((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")))))

43
scripts/bible2latex.in
View File

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

43
scripts/read-bible.in
View File

@ -1,16 +1,10 @@
#! /usr/bin/env sh #! /usr/bin/env sh
exec guile -e '(@ (read-bible) main)' -s "$0" "$@" exec guile -e main -s "$0" "$@"
!# !#
(define-module (read-bible) (use-modules (bible-tools bible-tools)
#:use-module (bible-tools bible-tools) (srfi srfi-1)
#:use-module (srfi srfi-1) (srfi srfi-26))
#:use-module (srfi srfi-26)
#:export (main))
(define (v->str v)
(string-append (book v) " " (chapter v) ":" (verse v)
"\t" (text v)))
(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")
@ -21,19 +15,20 @@ exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
(define (main args) (define (main args)
(define (pr t) (define (pr t)
(map (lambda (str) (display str) (newline)) (map v->str t))) (map (lambda (str) (display str) (newline)) (map verse->string t)))
(define version (cut display "read-bible v1.0.0\n")) (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?))
(define-syntax conf (let-syntax ((conf
(syntax-rules (else) (syntax-rules (else)
((_ (f e)...) (cond ((flag? f) e)... (else (help)))))) ((_ (f e)...) (cond ((flag? f) e)...
(if (< (length args) 2) (else (help)))))))
(help) (if (< (length args) 2)
(with-bible (cadr args) (help)
(conf ("-h" (help)) (with-bible (cadr args)
("-v" (version)) (conf ("-h" (help)) ("-v" (display version))
("-b" (if (flag? "-c") ("-b" (if (flag? "-c")
(call-with-chapter (get "-b") (call-with-chapter (get "-b")
(get "-c") pr) (get "-c") pr)
(call-with-book (get "-b") pr))))))) (call-with-book (get "-b")
pr))))))))

39
scripts/search-bible.in Normal file
View File

@ -0,0 +1,39 @@
#! /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))))))))

40
scripts/word-counter.in
View File

@ -1,13 +1,11 @@
#! /usr/bin/env sh #! /usr/bin/env sh
exec guile -e '(@ (word-counter) main)' -s "$0" "$@" exec guile -e main -s "$0" "$@"
!# !#
(define-module (word-counter) (use-modules (bible-tools bible-tools)
#:use-module (bible-tools bible-tools) (bible-tools count-words)
#:use-module (bible-tools count-words) (srfi srfi-1)
#:use-module (srfi srfi-1) (srfi srfi-26))
#:use-module (srfi srfi-26)
#:export (main))
(define (show t) (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"))
@ -17,24 +15,26 @@ exec guile -e '(@ (word-counter) main)' -s "$0" "$@"
(define (help) (define (help)
(display "Usage: word-counter [book] [-c chapter]") (display "Usage: word-counter [book] [-c chapter]")
(display "[-h] [-v] [--bible b]\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")) (display "\t--bible b use this bible\n"))
(define (main args) (define (main args)
(define version (cut display "count-words v1.0.0\n")) (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?))
(define-syntax conf (let-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))))))
(let ((bible (if (flag? "--bible") (get "--bible") "elb1871"))) (let ((bible (if (flag? "--bible") (get "--bible") "elb1871")))
(with-bible bible (with-bible bible
(conf ("-h" (help)) (conf ("-h" (help))
("-v" (version)) ("-v" (display version))
("-c" ("-c"
(call-with-chapter (cadr args) (get "-c") show)) (call-with-chapter (cadr args) (get "-c")
(else (if (< (length args) 2) (help) show))
(call-with-book (cadr args) show))))))) (else (if (< (length args) 2) (help)
(call-with-book (cadr args)
show))))))))