A lot of changes

bible-tools/bible-tools.scm

@@ -1,28 +1,16 @@
-(define-module (bible-tools)
+(define-module (bible-tools bible-tools)
   #: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 (mapcan
-            get-bible
-            string->bible
-            clean-strings
-            book
-            chapter
-            verse
-            text
-            get-book
-            get-chapter
-            get-verse
-            let-bible
-            call-with-book
-            call-with-chapter
+  #:export (book chapter verse text
+            get-book get-chapter get-verse
+            call-with-book call-with-chapter
             with-bible
-            with-book
-            with-chapter))
+	    verse->string clean-strings))
 
-(define (mapcan f l) (apply append (map f l)))
 (define make-bible-path
   (cut string-append (get-environment-variable "HOME")
        "/.bible/" <> ".tsv"))
@@ -32,18 +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)

bible-tools/count-words.scm

@@ -1,22 +1,32 @@
 (define-module (bible-tools count-words)
-  #:use-module (bible-tools)
+  #: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 '() <>)))

bible-tools/latex-export.scm

@@ -1,5 +1,5 @@
 (define-module (bible-tools latex-export)
-  #:use-module (bible-tools)
+  #:use-module (bible-tools bible-tools)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (as-latex))

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 "")

hall.scm

@@ -14,13 +14,14 @@
            ((directory
               "bible-tools"
               ((scheme-file "latex-export")
-               (scheme-file "count-words")))
-	    (scheme-file "bible-tools")))
+               (scheme-file "count-words")
+	       (scheme-file "bible-tools")))))
          (tests ((directory "tests" ())))
          (programs
            ((directory
               "scripts"
               ((in-file "bible-app")
+	       (in-file "search-bible")
                (in-file "word-counter")
                (in-file "bible2latex")
                (in-file "read-bible")))))

scripts/bible-app.in

@@ -3,7 +3,7 @@ exec guile -e '(@ (bible-app) main)' -s "$0" "$@"
 !#
 
 (define-module (bible-app)
-  #:use-module (bible-tools)
+  #:use-module (bible-tools bible-tools)
   #:use-module (bible-tools latex-export)
   #:use-module (bible-tools count-words)
   #:use-module (srfi srfi-1)

scripts/bible2latex.in

@@ -1,37 +1,36 @@
 #! /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))
-
-(define print-text (compose display as-latex))
+(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] [-h] [-v]\n")
+  (display "Usage: bible2latex [-b book] [-c chapter]")
+  (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")
-  (display "\t-v\t\tdisplay the current version\n"))
-
-(define (version)
-  (display "bible2latex v1.0.0\n"))
+  (display "\t-v\t\tdisplay the current version\n")
+  (display "\t--bible b use this bible\n"))
 
 (define (main args)
+  (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)))))
-  (with-bible "elb1871"
-              (conf ("-h" (help))
-                    ("-v" (version))
-                    ("-b" (if (flag? "-c")
-                              (call-with-chapter (get "-b") (get "-c")
-                                                 print-text)
-                              (call-with-book (get "-b") print-text)))
-                    (else print-text))))
+  (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))))))

scripts/read-bible.in

@@ -1,19 +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)
-  #: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)))
+(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")
@@ -22,22 +13,22 @@ exec guile -e '(@ (read-bible) main)' -s "$0" "$@"
   (display "\t-h\t\tdisplay this help message\n")
   (display "\t-v\t\tdisplay the current version\n"))
 
-(define (version)
-  (display "read-bible v1.0.0\n"))
-
 (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 get (compose cadr flag?))
-  (define-syntax conf
-    (syntax-rules (else)
-      ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
-  (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")
-                                                     print-text)
-                                  (call-with-book (get "-b") print-text)))
-                        (else (help))))))
+  (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))))))))

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))))))))

scripts/word-counter.in

@@ -1,39 +1,40 @@
 #! /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)
-  #: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-meta txt)
+(define (show t)
   (define (tabs w) (if (< (string-length (car w)) 7) "\t\t" "\t"))
   (define (to-str w) (string-append (car w) ":" (tabs w)
                                     (number->string (cdr w)) "\n"))
-  (for-each (compose display to-str) (count-words (map text txt))))
+  (for-each (compose display to-str) (count-words (map text t))))
 
 (define (help)
-  (display "Usage: count-words [book] [-c chapter] [-h] [-v]\n")
+  (display "Usage: word-counter [book] [-c chapter]")
+  (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"))
-
-(define (version)
-  (display "count-words v1.0.0\n"))
+  (display "\t-v display the current version\n")
+  (display "\t--bible b use this bible\n"))
 
 (define (main args)
+  (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)))))
-  (with-bible "elb1871"
-              (conf ("-h" (help))
-                    ("-v" (version))
-                    ("-c"
-                     (call-with-chapter (cadr args) (get "-c") show-meta))
-                    (else (if (< (length args) 2) (help)
-                              (call-with-book (cadr args) show-meta))))))
+  (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))))))))