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

A lot of changes

master
Silas Vedder 2 years ago
parent
272b4ba2b7
commit
a08efcef9c
Signed by: silasfox
GPG Key ID: 10DFF4A1DB187699
8 changed files with 130 additions and 79 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. 13
      bible-tools/bible-tools.scm
  2. 20
      bible-tools/count-words.scm
  3. 4
      guix.scm
  4. 1
      hall.scm
  5. 31
      scripts/bible2latex.in
  6. 29
      scripts/read-bible.in
  7. 39
      scripts/search-bible.in
  8. 30
      scripts/word-counter.in

13
bible-tools/bible-tools.scm
Unescape 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,10 +20,12 @@
(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 list-transduce (compose clean-strings (tmap string->verse))
rcons <>)
(cut string-split <> #\newline))) (cut string-split <> #\newline)))
(define book first) (define book first)
@ -30,6 +33,10 @@
(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)

20
bible-tools/count-words.scm
Unescape 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
Unescape 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
Unescape 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")))))

31
scripts/bible2latex.in
Unescape 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)...
(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))
("-b" (if (flag? "-c") ("-b" (if (flag? "-c")
(call-with-chapter (get "-b") (call-with-chapter (get "-b")
(get "-c") print) (get "-c") pr)
(call-with-book (get "-b") print))) (call-with-book (get "-b") pr)))
(else print))))) (else pr))))))

29
scripts/read-bible.in
Unescape 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)...
(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") pr) (get "-c") pr)
(call-with-book (get "-b") pr))))))) (call-with-book (get "-b")
pr))))))))

39
scripts/search-bible.in
Unescape 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))))))))

30
scripts/word-counter.in
Unescape 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")
show))
(else (if (< (length args) 2) (help) (else (if (< (length args) 2) (help)
(call-with-book (cadr args) show))))))) (call-with-book (cadr args)
show))))))))

Write Preview
Loading…
Cancel
Save