You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
66 lines
2.2 KiB
66 lines
2.2 KiB
2 years ago
|
#! /usr/bin/env sh
|
||
|
exec guile -l bible-tools.scm -e '(@ (count-words) main)' -s count-words "$@"
|
||
|
!#
|
||
|
|
||
|
(define-module (count-words)
|
||
|
#:use-module (bible-tools)
|
||
|
#:use-module (srfi srfi-1)
|
||
|
#: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 (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 (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)
|
||
|
(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))))))
|