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
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 15
      bible-tools/bible-tools.scm
  2. 24
      bible-tools/count-words.scm
  3. 4
      guix.scm
  4. 1
      hall.scm
  5. 43
      scripts/bible2latex.in
  6. 43
      scripts/read-bible.in
  7. 39
      scripts/search-bible.in
  8. 40
      scripts/word-counter.in

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

@ -2,13 +2,14 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-98)
#:use-module (srfi srfi-171)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:export (book chapter verse text
get-book get-chapter get-verse
call-with-book call-with-chapter
with-bible
clean-strings))
verse->string clean-strings))
(define make-bible-path
(cut string-append (get-environment-variable "HOME")
@ -19,17 +20,23 @@
(define string->verse (cut string-split <> #\tab))
(define clean-strings
(cut filter (compose not (cut string=? <> "")) <>))
(tfilter (compose not (cut string=? <> ""))))
(define string->bible
(compose (cut map string->verse <>) clean-strings
(cut string-split <> #\newline)))
(compose
(cut list-transduce (compose clean-strings (tmap string->verse))
rcons <>)
(cut string-split <> #\newline)))
(define book first)
(define chapter fourth)
(define verse fifth)
(define text sixth)
(define (verse->string v)
(string-append (book v) " " (chapter v) ":" (verse v)
"\t" (text v)))
(define (get-num query bible part)
(filter (compose (cut = query <>) string->number part) bible))
(define (get-book book-name bible)

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

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

4
guix.scm
Unescape View File

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

1
hall.scm
Unescape View File

@ -21,6 +21,7 @@
((directory
"scripts"
((in-file "bible-app")
(in-file "search-bible")
(in-file "word-counter")
(in-file "bible2latex")
(in-file "read-bible")))))

43
scripts/bible2latex.in
Unescape View File

@ -1,17 +1,15 @@
#! /usr/bin/env sh
exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
exec guile -e main -s "$0" "$@"
!#
(define-module (bible2latex)
#:use-module (bible-tools)
#:use-module (bible-tools latex-export)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (main))
(use-modules (bible-tools bible-tools)
(bible-tools latex-export)
(srfi srfi-1)
(srfi srfi-26))
(define (help)
(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-c chapter\texport this chapter to latex\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"))
(define (main args)
(define version (cut display "bible2latex v1.0.0\n"))
(define print (compose display as-latex))
(define version "bible2latex v1.0.0\n")
(define pr (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)))))
(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)))))
(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 pr))))))

43
scripts/read-bible.in
Unescape View File

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

40
scripts/word-counter.in
Unescape View File

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

Write Preview
Loading…
Cancel
Save