diff options
Diffstat (limited to 'lib/guile/read-habit.scm')
-rwxr-xr-x | lib/guile/read-habit.scm | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/lib/guile/read-habit.scm b/lib/guile/read-habit.scm new file mode 100755 index 0000000..7ba7002 --- /dev/null +++ b/lib/guile/read-habit.scm @@ -0,0 +1,68 @@ +#!/usr/bin/guile \ +--listen -s +!# + +(add-to-load-path "/home/titan/dev/helpful_scripts/guile/") + +(use-modules (ice-9 rdelim) + (ice-9 popen) + (ice-9 ftw) + (ice-9 format) + (term ansi-color) + (web request) + (json) + (web response) + (web server) + (web uri) + (utils)) + +(define habits-dir (expand-file "~/org/habits/")) + +(define (parse-file port) + (let loop ((values '()) + (line (read-line port))) + (if (eof-object? line) + (reverse values) + (loop (cons (map string->number (string-split line #\:)) values) + (read-line port))))) + +(define (cli-print file-name) + (map (lambda (row) + (format #t "~a -> ~d~%" + (colorize-string (strftime "%c" (localtime (car row))) 'CYAN 'BOLD) + (cadr row))) + (call-with-input-file (string-append habits-dir file-name) + parse-file))) + +(define (request-path-components request) + (split-and-decode-uri-path (uri-path (request-uri request)))) + +(define (not-found request) + (values (build-response #:code 404) + (string-append "Resource not found: " + (uri->string (request-uri request))))) + +(define (handle-request request request-body) + (and=> request-body display) + (newline) + (let ((path (request-path-components request)) ) + (display path) + (cond ((null? path) + (values '((content-type . (application/json))) + (scm->json-string (list->vector (scandir habits-dir))))) + ((file-exists? (string-append habits-dir (car path))) + (values '((content-type . (application/json))) + (scm->json-string (list->vector + (map (lambda (row) (list->vector row)) + (call-with-input-file (string-append habits-dir (car path)) + parse-file)))))) + ((string=? "hi" (car path)) + (values '((content-type . (application/json))) + '(hi))) + (else (not-found request))))) + + +(cli-print "pull-ups.dat") +(display "pu\n") +(cli-print "push-ups.dat") +;(run-server (lambda (request request-body) (handle-request request request-body))) |