aboutsummaryrefslogtreecommitdiffstats
path: root/lib/guile/read-habit.scm
blob: 7ba70026e9f890fdea97b363dce129a7d46cac81 (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
#!/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)))