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
Unified 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. 150
      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) (define-module (bible-tools)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-98) #:use-module (srfi srfi-98)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:export (mapcan #:export (mapcan
get-bible get-bible
string->bible string->bible
clean-strings
book book
chapter chapter
verse verse
@ -13,36 +15,47 @@
get-book get-book
get-chapter get-chapter
get-verse 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 (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) (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) (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) (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)))))

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

150
guix.scm
Unescape View File

@ -1,90 +1,80 @@
(use-modules (use-modules (guix packages)
(guix packages) ((guix licenses)
((guix licenses) #:prefix license:) #:prefix license:)
(guix download) (guix download)
(guix git-download) (guix git-download)
(guix build-system gnu) (guix build-system gnu)
(gnu packages) (gnu packages)
(gnu packages autotools) (gnu packages autotools)
(gnu packages guile) (gnu packages guile)
(gnu packages guile-xyz) (gnu packages guile-xyz)
(gnu packages pkg-config) (gnu packages pkg-config)
(gnu packages texinfo)) (gnu packages texinfo))
(define-public bible-tools (define-public bible-tools
(package (package
(name "bible-tools") (name "bible-tools")
(version "1.0") (version "1.0")
(source (source (origin
(origin (method git-fetch)
(method git-fetch) (uri (git-reference
(uri (git-reference (url
(url "https://git.silasvedder.xyz/silasfox/bible-tools.git") "https://git.silasvedder.xyz/silasfox/bible-tools.git")
(commit "2e7be5e"))) (commit "89c5290")))
(file-name "bible-tools-1.0-checkout") (file-name "bible-tools-1.0-checkout")
(sha256 (base32 "0l3ndyzy6sq1cdkaklhyg1mvy6hsil7b86wk3nbs5mqgrcypar1z")))) (sha256
(base32
"0rdpn3digjxmsxqxjilgrh5fsa7v72mnwm91083wngfimvvkm6i2"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:modules `(#:modules ((ice-9 match)
((ice-9 match) (ice-9 ftw)
(ice-9 ftw) ,@%gnu-build-system-modules)
,@%gnu-build-system-modules) #:phases (modify-phases %standard-phases
#:phases (add-after 'install 'hall-wrap-binaries
(modify-phases (lambda* (#:key inputs outputs #:allow-other-keys)
%standard-phases (let* ((compiled-dir (lambda (out version)
(add-after (string-append out "/lib/guile/"
'install version
'hall-wrap-binaries "/site-ccache")))
(lambda* (#:key inputs outputs #:allow-other-keys) (uncompiled-dir (lambda (out version)
(let* ((compiled-dir (string-append out
(lambda (out version) "/share/guile/site"
(string-append (if (string-null? version) ""
out "/") version)))
"/lib/guile/" (dep-path (lambda (env modules path)
version (list env ":"
"/site-ccache"))) 'prefix
(uncompiled-dir (cons modules
(lambda (out version) (map (lambda (input)
(string-append (string-append (assoc-ref
out inputs
"/share/guile/site" input)
(if (string-null? version) "" "/") path))
version))) ,''())))))
(dep-path (out (assoc-ref outputs "out"))
(lambda (env modules path) (bin (string-append out "/bin/"))
(list env (site (uncompiled-dir out "")))
":" (match (scandir site)
'prefix (("." ".." version)
(cons modules (for-each (lambda (file)
(map (lambda (input) (wrap-program (string-append bin file)
(string-append (dep-path
(assoc-ref inputs input) "GUILE_LOAD_PATH"
path)) (uncompiled-dir out
,''()))))) version)
(out (assoc-ref outputs "out")) (uncompiled-dir ""
(bin (string-append out "/bin/")) version))
(site (uncompiled-dir out ""))) (dep-path
(match (scandir site) "GUILE_LOAD_COMPILED_PATH"
(("." ".." version) (compiled-dir out
(for-each version)
(lambda (file) (compiled-dir "" version))))
(wrap-program ,''("bible2latex" "count-words")) #t))))))))
(string-append bin file) (native-inputs `(("autoconf" ,autoconf)
(dep-path ("automake" ,automake)
"GUILE_LOAD_PATH" ("pkg-config" ,pkg-config)
(uncompiled-dir out version) ("texinfo" ,texinfo)))
(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))) (inputs `(("guile" ,guile-3.0)))
(propagated-inputs `()) (propagated-inputs `())
(synopsis "") (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) (define-module (bible2latex)
#:use-module (bible-tools) #:use-module (bible-tools)
#:use-module (latex-export)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (main)) #: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) (define (help)
(display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n") (display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n")
@ -37,26 +21,17 @@ exec guile -e '(@ (bible2latex) main)' -s "$0" "$@"
(define (version) (define (version)
(display "bible2latex v1.0.0\n")) (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 (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" (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)))) (else print-text))))

61
scripts/count-words.in
Unescape View File

@ -2,42 +2,18 @@
exec guile -e '(@ (count-words) main)' -s "$0" "$@" exec guile -e '(@ (count-words) main)' -s "$0" "$@"
!# !#
(define-module (count-words) (define-module (word-counter)
#:use-module (bible-tools) #:use-module (bible-tools)
#:use-module (count-words)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (main)) #: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) (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) (define (help)
(display "Usage: count-words [book] [-c chapter] [-h] [-v]\n") (display "Usage: count-words [book] [-c chapter] [-h] [-v]\n")
@ -48,18 +24,15 @@ exec guile -e '(@ (count-words) main)' -s "$0" "$@"
(define (version) (define (version)
(display "count-words v1.0.0\n")) (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 (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" (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)))))

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