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. 78
      guix.scm
  5. 14
      scripts/bible-app.in
  6. 53
      scripts/bible2latex.in
  7. 61
      scripts/count-words.in
  8. 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"))

78
guix.scm
Unescape View File

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

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