#!/bin/sh
#-*-scheme-*-

exec /home/gbenison/local-env guile -s $0 2>/dev/null
# exec guile -s 2>>guile-error.txt $0 $@

!#
(use-modules (srfi srfi-1)
	     (sxml simple)
	     (www cgi))

(define default-min-word-length 5)

; ---------- utilities ----------

(define (string-depunctuate str)
  (list->string (filter char-alphabetic? (string->list str))))

(define (count-occurences xs)
  (fold (lambda (next result)
	  (if (and (not (null? result))
		   (equal? (caar result) next))
	      (cons (cons (caar result)
			  (+ (cdar result) 1))
		    (cdr result))
	      (cons (cons next 1) result)))
	'()
	xs))

(define (string-not-empty? str)
  (> (string-length str) 0))

(define (string-longer-than? n)
  (lambda (str)(> (string-length str) n)))

(define (word-usage msg)
  (count-occurences
   (sort
    (filter
     (string-longer-than? (- min-word-length 1))
     (map string-depunctuate
	  (string-tokenize (string-downcase msg))))
    string<?)))

(define (lesser-of a b)(if (< a b) a b))

(define (take-at-most xs n)
  (take xs (lesser-of n (length xs))))

(define (cdr>? a b)(> (cdr a)(cdr b)))

(define (top-word-usage msg n)
  (take-at-most (sort (word-usage msg) cdr>?) n))

(define (format-usage usage)
  (format #f "~a -- ~a occurrences" (car usage)(cdr usage)))

(define (as-li content)
  `(li ,content))

; ------ output -----------

(cgi:init)

(define input
  (and (cgi:form-data?)
       (car (cgi:values "input-content"))))

(define min-word-length
  (or
   (false-if-exception (string->number (car (cgi:values "min-length"))))
   default-min-word-length))

(display "Content-type: text/html\n\n")
(sxml->xml
 `(html
   (head (title "wc demo")
	 (link (@ (rel "stylesheet")(type "text/css")(href "style/word-usage.css"))))
   (body
    (h1 (a (@ (href ,(car (command-line)))) "Word count demo"))
    (p "This is a toy web application written in Scheme by "
       (a (@ (href "http://www.linkedin.com/in/gregorybenison"))"Greg Benison") ".  I blogged about it "
       (a (@ (href "http://gcbenison.wordpress.com/2012/02/19/guile-vs-php"))"here") ". "
       "Check out the " (a (@ (href "src/word-usage")) "source code")
       ", or try pasting in the text of an email "
       "or a chapter from a favorite book below!"
     )
    ,(if input
	 `(p "Top words of at least " ,min-word-length " characters:"
	     (ul
	      ,(map as-li
		    (map format-usage (top-word-usage input 5)))))
	    '(p "Enter some text below, to count word usage:")))
    (form (@ (method "post")
	     (name "input-form")
	     (action ,(car (command-line))))
	  (textarea (@ (name "input-content")
		       (rows 20)
		       (cols 60))
		    ,(or input ""))
	  (p "Minimum word length: "
	     (input (@ (type "text")
		       (name "min-length"))))
	  (input (@ (type "submit")
		    (name "input-submit")
		    (value "Determine word usage")))))))