blob: 7c04422098f5bdaab93a1db66ccc5a4dfb217985 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
#!/usr/bin/guile \
--listen -s
!#
(add-to-load-path "/home/titan/dev/dotfiles/lib/guile/")
(use-modules (ice-9 format)
(ice-9 ftw)
(ice-9 popen)
(ice-9 rdelim)
(json)
(term ansi-color)
(utils)
(web request)
(web response)
(web server)
(web uri))
(define habits-dir (expand-file "~/org/habits/"))
(define (iter-lines filename proc)
(call-with-input-file filename
(lambda (port)
(let loop ((values '())
(line (read-line port)))
(if (eof-object? line)
(reverse values)
(loop (cons (proc line) values)
(read-line port)))))))
(define (cli-print file-name)
(iter-lines
(string-append habits-dir file-name)
(lambda (line)
(let ((row (map string->number (string-split line #\:))))
(format #t "~a -> ~d~%"
(colorize-string (strftime "%c" (localtime (car row))) 'CYAN 'BOLD)
(cadr row))
row))))
(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
(iter-lines
(string-append habits-dir (car path))
(lambda (line)
(list->vector (map string->number (string-split line #\:)))))))))
((string=? "hi" (car path))
(values '((content-type . (application/json)))
'(hi)))
(else (not-found request)))))
(cli-print "pull-ups.dat")
(display "pu\n")
(cli-print "poop.dat")
;(run-server (lambda (request request-body) (handle-request request request-body)))
|
