scripts split from implementation of counter and latex export

bible-tools.scm

@@ -1,11 +1,13 @@
 (define-module (bible-tools)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-98)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:export (mapcan
             get-bible
             string->bible
+            clean-strings
             book
             chapter
             verse
@@ -13,36 +15,47 @@
             get-book
             get-chapter
             get-verse
-            with-bible))
+            let-bible
+            call-with-book
+            call-with-chapter
+            with-bible
+            with-book
+            with-chapter))
 
 (define (mapcan f l) (apply append (map f l)))
-(define (make-bible-path name)
+(define make-bible-path
-  (string-append (get-environment-variable "HOME") "/.bible/" name ".tsv"))
+  (cut string-append (get-environment-variable "HOME")
+       "/.bible/" <> ".tsv"))
 (define (get-bible name)
-  (call-with-input-file (make-bible-path name) (compose utf8->string get-bytevector-all)))
+  (call-with-input-file (make-bible-path name)
+    (compose utf8->string get-bytevector-all)))
 
-(define (string->verse string)
+(define string->verse (cut string-split <> #\tab))
-  (string-split string #\tab))
+(define clean-strings
+  (cut filter (compose not (cut string=? <> "")) <>))
 
-(define (string->bible string)
+(define string->bible
-  (map string->verse
+  (compose (cut map string->verse <>)
-       (filter (lambda (str) (not (string=? str "")))
+           clean-strings
-               (string-split string #\newline))))
+           (cut string-split <> #\newline)))
 
-(define book car)
+(define book first)
-(define chapter cadddr)
+(define chapter fourth)
-(define verse (compose cadddr cdr))
+(define verse fifth)
-(define text (compose cadddr cddr))
+(define text sixth)
 
-(define (get-num bible query part)
+(define (get-num query bible part)
-  (filter (lambda (v) (= query (string->number (part v)))) bible))
+  (filter (compose (cut = query <>) string->number part) bible))
 (define (get-book book-name bible)
-  (filter (lambda (v) (string=? book-name (book v))) bible))
+  (filter (compose (cut string=? book-name <>) book) bible))
-(define (get-chapter chapter-number book)
+(define get-chapter (cut get-num <> <> chapter))
-  (get-num book chapter-number chapter))
+(define get-verse (cut get-num <> <> verse))
-(define (get-verse verse-number chapter)
-  (get-num chapter verse-number verse))
 
 (define (with-bible b f)
-  (when (procedure? f)
+  (when (procedure? f) (f (string->bible (get-bible b)))))
-    (f (string->bible (get-bible b)))))
+
+(define (call-with-book book thunk)
+  (compose thunk (cut get-book book <>)))
+(define (call-with-chapter book chapter thunk)
+  (lambda (bible) (thunk (get-chapter (string->number chapter)
+                                      (get-book book bible)))))

bible-tools/count-words.scm

@@ -0,0 +1,22 @@
+(define-module (count-words)
+  #:use-module (bible-tools)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (count-words))
+
+(define (split/stuff str)
+  (define (split-curry char) (cut string-split <> char))
+  (let ((splits (map split-curry '(#\, #\: #\. #\! #\? #\; #\< #\>))))
+    (clean-strings (fold mapcan (string-split str #\space) splits))))
+
+(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)))
+
+(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 '() <>)))

bible-tools/latex-export.scm

@@ -0,0 +1,23 @@
+(define-module (latex-export)
+  #:use-module (bible-tools)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (as-latex))
+
+(define (verse-to-latex v)
+  (define (latex-first c sec b sec-end)
+    (if (string=? (c v) "1") (string-append sec (b v) sec-end) ""))
+  (let* ((book (latex-first chapter "\\section{" book "}\n"))
+         (chapter
+          (latex-first verse "\\textbf{\\large{" chapter "}}\n")))
+    (string-append chapter
+                   "\\textsuperscript{" (verse v) "}" (text v))))
+
+(define (as-latex text)
+  (string-append "\\documentclass{article}\n\n"
+                 "\\usepackage{fullpage}\n\n"
+                 "\\begin{document}\n\n"
+                 (string-join
+                  (map verse-to-latex text)
+                  "\n\n")
+                 "\n\\end{document}\n"))

guix.scm

@@ -1,6 +1,6 @@
-(use-modules
+(use-modules (guix packages)
-  (guix packages)
+             ((guix licenses)
-  ((guix licenses) #:prefix license:)
+              #:prefix license:)
              (guix download)
              (guix git-download)
              (guix build-system gnu)
@@ -15,50 +15,41 @@
   (package
     (name "bible-tools")
     (version "1.0")
-    (source
+    (source (origin
-      (origin
               (method git-fetch)
               (uri (git-reference
-               (url "https://git.silasvedder.xyz/silasfox/bible-tools.git")
+                    (url
-               (commit "2e7be5e")))
+                     "https://git.silasvedder.xyz/silasfox/bible-tools.git")
+                    (commit "89c5290")))
               (file-name "bible-tools-1.0-checkout")
-        (sha256 (base32 "0l3ndyzy6sq1cdkaklhyg1mvy6hsil7b86wk3nbs5mqgrcypar1z"))))
+              (sha256
+               (base32
+                "0rdpn3digjxmsxqxjilgrh5fsa7v72mnwm91083wngfimvvkm6i2"))))
     (build-system gnu-build-system)
     (arguments
-      `(#:modules
+     `(#:modules ((ice-9 match)
-        ((ice-9 match)
                   (ice-9 ftw)
                   ,@%gnu-build-system-modules)
-        #:phases
+       #:phases (modify-phases %standard-phases
-        (modify-phases
+                  (add-after 'install 'hall-wrap-binaries
-          %standard-phases
-          (add-after
-            'install
-            'hall-wrap-binaries
                     (lambda* (#:key inputs outputs #:allow-other-keys)
-              (let* ((compiled-dir
+                      (let* ((compiled-dir (lambda (out version)
-                       (lambda (out version)
+                                             (string-append out "/lib/guile/"
-                         (string-append
-                           out
-                           "/lib/guile/"
                                                             version
                                                             "/site-ccache")))
-                     (uncompiled-dir
+                             (uncompiled-dir (lambda (out version)
-                       (lambda (out version)
+                                               (string-append out
-                         (string-append
-                           out
                                                 "/share/guile/site"
-                           (if (string-null? version) "" "/")
+                                                (if (string-null? version) ""
-                           version)))
+                                                    "/") version)))
-                     (dep-path
+                             (dep-path (lambda (env modules path)
-                       (lambda (env modules path)
+                                         (list env ":"
-                         (list env
-                               ":"
                                                'prefix
                                                (cons modules
                                                      (map (lambda (input)
-                                            (string-append
+                                                            (string-append (assoc-ref
-                                              (assoc-ref inputs input)
+                                                                            inputs
+                                                                            input)
                                                              path))
                                                           ,''())))))
                              (out (assoc-ref outputs "out"))
@@ -66,22 +57,21 @@
                              (site (uncompiled-dir out "")))
                         (match (scandir site)
                           (("." ".." version)
-                        (for-each
+                           (for-each (lambda (file)
-                          (lambda (file)
+                                       (wrap-program (string-append bin file)
-                            (wrap-program
-                              (string-append bin file)
                                                      (dep-path
                                                       "GUILE_LOAD_PATH"
-                                (uncompiled-dir out version)
+                                                      (uncompiled-dir out
-                                (uncompiled-dir "" version))
+                                                                      version)
+                                                      (uncompiled-dir ""
+                                                                      version))
                                                      (dep-path
                                                       "GUILE_LOAD_COMPILED_PATH"
-                                (compiled-dir out version)
+                                                      (compiled-dir out
+                                                                    version)
                                                       (compiled-dir "" version))))
-                          ,''("bible2latex" "count-words"))
+                                     ,''("bible2latex" "count-words")) #t))))))))
-                        #t))))))))
+    (native-inputs `(("autoconf" ,autoconf)
-    (native-inputs
-      `(("autoconf" ,autoconf)
                      ("automake" ,automake)
                      ("pkg-config" ,pkg-config)
                      ("texinfo" ,texinfo)))

scripts/bible-app.in

@@ -0,0 +1,14 @@
+#! /usr/bin/env sh
+exec guile -e '(@ (bible-app) main)' -s "$0" "$@"
+!#
+
+(define-module (bible-app)
+  #:use-module (bible-tools)
+  #:use-module (latex-export)
+  #:use-module (count-words)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (main))
+
+(define (main args)
+  (display args))

scripts/bible2latex.in

@@ -4,28 +4,12 @@ exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
 
 (define-module (bible2latex)
   #:use-module (bible-tools)
+  #:use-module (latex-export)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (main))
 
-(define (verse-to-latex v)
+(define print-text (compose display as-latex))
-  (string-append (if (string=? (verse v) "1")
-                     (string-append (if (string=? (chapter v) "1")
-                                        (string-append "\\section{" (book v) "}\n") "")
-                                    "\\textbf{\\large{" (chapter v) "}}\n")
-                     "")
-                 "\\textsuperscript{" (verse v) "}" (text v)))
-
-(define (print-text text)
-  (let ((result (string-append "\\documentclass{article}\n\n"
-                               "\\usepackage{fullpage}\n\n"
-                               "\\begin{document}\n\n"
-                               (string-join
-                                (map verse-to-latex text)
-                                "\n\n")
-                               "\n\\end{document}")))
-    (display result)
-    (newline)))
-
 
 (define (help)
   (display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n")
@@ -37,26 +21,17 @@ exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
 (define (version)
   (display "bible2latex v1.0.0\n"))
 
-(define (print-book book)
-  (lambda (bible)
-    (print-text (get-book book bible))))
-
-(define (print-chapter book chapter)
-  (lambda (bible)
-    (print-text (get-chapter (string->number chapter)
-                             (get-book book bible)))))
-
-
 (define (main args)
-  (define (get-flag flag)
+  (define flag? (cut member <> args))
-    (cadr (member flag args)))
+  (define get (compose cadr flag?))
-  (define (flag? flag)
+  (define-syntax conf
-    (member flag args))
+    (syntax-rules (else)
+      ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g)))))
   (with-bible "jantzen"
-              (cond ((flag? "-h") (help))
+              (conf ("-h" (help))
-                    ((flag? "-v") (version))
+                    ("-v" (version))
-                    ((flag? "-b") (if (flag? "-c")
+                    ("-b" (if (flag? "-c")
-                                      (print-chapter (get-flag "-b")
+                              (call-with-chapter (get "-b") (get "-c")
-                                                     (get-flag "-c"))
+                                                 print-text)
-                                      (print-book (get-flag "-b"))))
+                              (call-with-book (get "-b") print-text)))
                     (else print-text))))

scripts/count-words.in

@@ -2,42 +2,18 @@
 exec guile -e '(@ (count-words) main)' -s "$0" "$@"
 !#
 
-(define-module (count-words)
+(define-module (word-counter)
   #:use-module (bible-tools)
+  #:use-module (count-words)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (main))
 
-(define (split/stuff str)
-  (let ((words (string-split str #\space))
-        (fs (map (lambda (char)
-                   (lambda (str) (string-split str char)))
-                 '(#\, #\: #\. #\! #\? #\; #\< #\>))))
-    (filter (lambda (str) (not (string=? "" str)))
-	    (fold (lambda (f val) (mapcan f val)) words fs))))
-
-(define (count verse result)
-  (let ((words (split/stuff verse)))
-    (fold (lambda (word res)
-            (let ((val (assoc word res)))
-              (if val
-                  (alist-cons word (+ (cdr val) 1) res)
-                  (alist-cons word 1 res))))
-          result words)))
-
-(define (count-words verses)
-  (delete-duplicates (sort (fold count '() verses)
-                           (lambda (a b) (> (cdr a) (cdr b))))
-                     (lambda (a b) (equal? (car a) (car b)))))
-
 (define (show-meta txt)
-  (let ((count (count-words (map text txt))))
+  (define (tabs w) (if (< (string-length (car w)) 7) "\t\t" "\t"))
-    (for-each (lambda (word)
+  (define (to-str w) (string-append (car w) ":" (tabs w)
-                (display
+                                    (number->string (cdr w)) "\n"))
-                 (string-append (car word)
+  (for-each (compose display to-str) (count-words (map text txt))))
-                                ":\t"
-                                (number->string (cdr word))
-                                "\n")))
-              count)))
 
 (define (help)
   (display "Usage: count-words [book] [-c chapter] [-h] [-v]\n")
@@ -48,18 +24,15 @@ exec guile -e '(@ (count-words) main)' -s "$0" "$@"
 (define (version)
   (display "count-words v1.0.0\n"))
 
-(define (show-book book)
-  (lambda (bible)
-    (show-meta (get-book book bible))))
-
-(define (show-chapter book chapter)
-  (lambda (bible)
-    (show-meta (get-chapter chapter (get-book book bible)))))
-
 (define (main args)
+  (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 "jantzen"
-              (cond ((< (length args) 2) (help))
+              (conf ("-h" (help))
-                    ((member "-h" args) (help))
+                    ("-v" (version))
-                    ((member "-v" args) (version))
+                    ("-c"
-                    ((member "-c" args) (show-chapter (cadr args) (string->number (cadr (member "-c" args)))))
+                     (call-with-chapter (cadr args) (get "-c") show-meta))
-                    (else (show-book (cadr args))))))
+                    (else (call-with-book (cadr args) show-meta)))))

scripts/word-counter.in

@@ -0,0 +1,38 @@
+#! /usr/bin/env sh
+exec guile -e '(@ (count-words) main)' -s "$0" "$@"
+!#
+
+(define-module (word-counter)
+  #:use-module (bible-tools)
+  #:use-module (count-words)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (main))
+
+(define (show-meta txt)
+  (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))))
+
+(define (help)
+  (display "Usage: count-words [book] [-c chapter] [-h] [-v]\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"))
+
+(define (main args)
+  (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 "jantzen"
+              (conf ("-h" (help))
+                    ("-v" (version))
+                    ("-c"
+                     (call-with-chapter (cadr args) (get "-c") show-meta))
+                    (else (call-with-book (cadr args) show-meta)))))