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

scripts split from implementation of counter and latex export

master
Silas Vedder 2 years ago
parent
89c529053b
commit
48bb7cc7f0
9 changed files with 237 additions and 189 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. 59
      bible-tools.scm
  2. 22
      bible-tools/count-words.scm
  3. 23
      bible-tools/latex-export.scm
  4. 6
      doc/bible-tools.texi
  5. 150
      guix.scm
  6. 14
      scripts/bible-app.in
  7. 53
      scripts/bible2latex.in
  8. 61
      scripts/count-words.in
  9. 38
      scripts/word-counter.in

59
bible-tools.scm
Unescape View File

@ -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)
(string-append (get-environment-variable "HOME") "/.bible/" name ".tsv"))
(define make-bible-path
(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)
(string-split string #\tab))
(define string->verse (cut string-split <> #\tab))
(define clean-strings
(cut filter (compose not (cut string=? <> "")) <>))
(define (string->bible string)
(map string->verse
(filter (lambda (str) (not (string=? str "")))
(string-split string #\newline))))
(define string->bible
(compose (cut map string->verse <>)
clean-strings
(cut string-split <> #\newline)))
(define book car)
(define chapter cadddr)
(define verse (compose cadddr cdr))
(define text (compose cadddr cddr))
(define book first)
(define chapter fourth)
(define verse fifth)
(define text sixth)
(define (get-num bible query part)
(filter (lambda (v) (= query (string->number (part v)))) bible))
(define (get-num query bible part)
(filter (compose (cut = query <>) string->number part) bible))
(define (get-book book-name bible)
(filter (lambda (v) (string=? book-name (book v))) bible))
(define (get-chapter chapter-number book)
(get-num book chapter-number chapter))
(define (get-verse verse-number chapter)
(get-num chapter verse-number verse))
(filter (compose (cut string=? book-name <>) book) bible))
(define get-chapter (cut get-num <> <> chapter))
(define get-verse (cut get-num <> <> verse))
(define (with-bible b f)
(when (procedure? f)
(f (string->bible (get-bible b)))))
(when (procedure? f) (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)))))

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

@ -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 '() <>)))

23
bible-tools/latex-export.scm
Unescape View File

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

6
doc/bible-tools.texi
Unescape View File

@ -10,7 +10,7 @@
@include version.texi
@copying
Copyright @copyright{} 2022
Copyright @copyright{} 2022
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -22,12 +22,12 @@ Documentation License''.
@dircategory The Algorithmic Language Scheme
@direntry
* Bible-Tools: (bible-tools).
* Bible-Tools: (bible-tools).
@end direntry
@titlepage
@title The Bible-Tools Manual
@author
@author
@page
@vskip 0pt plus 1filll

150
guix.scm
Unescape View File

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

14
scripts/bible-app.in
Unescape View File

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

53
scripts/bible2latex.in
Unescape View File

@ -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)
(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 print-text (compose display as-latex))
(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)
(cadr (member flag args)))
(define (flag? flag)
(member flag 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 ((flag? "-h") (help))
((flag? "-v") (version))
((flag? "-b") (if (flag? "-c")
(print-chapter (get-flag "-b")
(get-flag "-c"))
(print-book (get-flag "-b"))))
(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))))

61
scripts/count-words.in
Unescape View File

@ -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))))
(for-each (lambda (word)
(display
(string-append (car word)
":\t"
(number->string (cdr word))
"\n")))
count)))
(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")
@ -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))
((member "-h" args) (help))
((member "-v" args) (version))
((member "-c" args) (show-chapter (cadr args) (string->number (cadr (member "-c" args)))))
(else (show-book (cadr args))))))
(conf ("-h" (help))
("-v" (version))
("-c"
(call-with-chapter (cadr args) (get "-c") show-meta))
(else (call-with-book (cadr args) show-meta)))))

38
scripts/word-counter.in
Unescape View File

@ -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)))))
Write Preview
Loading…
Cancel
Save