From a08efcef9cdc089e4b401247c69efe7783596f92 Mon Sep 17 00:00:00 2001 From: Silas Vedder Date: Fri, 11 Nov 2022 12:29:21 +0100 Subject: [PATCH] A lot of changes --- bible-tools/bible-tools.scm | 15 +++++++++---- bible-tools/count-words.scm | 24 ++++++++++++++------- guix.scm | 4 +++- hall.scm | 1 + scripts/bible2latex.in | 43 ++++++++++++++++++------------------- scripts/read-bible.in | 43 ++++++++++++++++--------------------- scripts/search-bible.in | 39 +++++++++++++++++++++++++++++++++ scripts/word-counter.in | 40 +++++++++++++++++----------------- 8 files changed, 130 insertions(+), 79 deletions(-) create mode 100644 scripts/search-bible.in diff --git a/bible-tools/bible-tools.scm b/bible-tools/bible-tools.scm index d65bd2b..b23b27b 100644 --- a/bible-tools/bible-tools.scm +++ b/bible-tools/bible-tools.scm @@ -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) diff --git a/bible-tools/count-words.scm b/bible-tools/count-words.scm index 67bb697..59a537a 100644 --- a/bible-tools/count-words.scm +++ b/bible-tools/count-words.scm @@ -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 '() <>))) diff --git a/guix.scm b/guix.scm index 5411ba3..91dc615 100644 --- a/guix.scm +++ b/guix.scm @@ -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 "") diff --git a/hall.scm b/hall.scm index 7a8256d..1a79802 100644 --- a/hall.scm +++ b/hall.scm @@ -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"))))) diff --git a/scripts/bible2latex.in b/scripts/bible2latex.in index d8cafbe..d5ee2ae 100755 --- a/scripts/bible2latex.in +++ b/scripts/bible2latex.in @@ -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)))))) diff --git a/scripts/read-bible.in b/scripts/read-bible.in index 621c178..e6644e3 100644 --- a/scripts/read-bible.in +++ b/scripts/read-bible.in @@ -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)))))))) diff --git a/scripts/search-bible.in b/scripts/search-bible.in new file mode 100644 index 0000000..681f629 --- /dev/null +++ b/scripts/search-bible.in @@ -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)))))))) diff --git a/scripts/word-counter.in b/scripts/word-counter.in index 94c0660..43fbd32 100644 --- a/scripts/word-counter.in +++ b/scripts/word-counter.in @@ -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))))))))