#!/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)))