aboutsummaryrefslogtreecommitdiffstats
path: root/lib/guile/read-habit.scm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/guile/read-habit.scm')
-rwxr-xr-xlib/guile/read-habit.scm68
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)))