aboutsummaryrefslogtreecommitdiffstats
path: root/lib/guile/read-habit.scm
blob: b3c7888f6b08e41c62a5562d66c331534986056c (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/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 (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 "push-ups.dat")
;(run-server (lambda (request request-body) (handle-request request request-body)))