fit/web.rkt at master · bdj/fit · GitHub

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
74
75
76
77
78
79
80
81
82
83
84
85
#lang racket/base
(require web-server/servlet
         web-server/servlet-env
         web-server/formlets
         web-server/formlets/dyn-syntax
         racket/list
         "weights.rkt")

(define exercises (make-parameter '(("Squat" "Bench Press") ("Deadlift" "Military Press"))))

(define (max-formlet exercise)
  (formlet (label ,exercise
              ,(=> input-int max))
           (cons exercise max)))

; todo : Ask Jay about a #%#* form that would allow top level lists turn into forests
(define maxes-formlet
  (formlet* `(div ,@(for*/list ([day (exercises)]
                                [exercise day])
                      (=>* (max-formlet exercise) maxes)))
            (make-hash maxes)))

(define (max-form results-url)
  (response/xexpr
   `(html (head (title "fit")
                (link ([rel "stylesheet"] [type "text/css"] [href "/style.css"])))
          (body (form ([action ,results-url])
                      ,@(formlet-display maxes-formlet)
                      (input ([type "submit"])))))))

(define (plan-table day week maxes)
  (define a-plan (plan day week maxes (exercises)))
  `(table
    (tr (th "#") (th "Exercise") (th "Weights") (th "Reps") (th "Actual Reps"))
    ,@(for/list ([i (in-naturals 1)]
                 [row a-plan])
        `(tr (td ,(number->string i))
             (td ,(first row))
             (td ,(weights-format (third row)))
             (td ,(number->string (second row)))
             (td)))))

(define (cookie-lookup req key)
  (define cookies (request-cookies req))
  (define cookie (findf (λ (c) (string=? key (client-cookie-name c))) cookies))
  (and cookie (client-cookie-value cookie)))

(define username-formlet
  (formlet (label "username"
                  ,(=> input-string username))
           username))

(define (username-form results-url)
  (response/xexpr
   `(html (head (title "fit-username")
                (link ([rel "stylesheet"] [type "text/css"] [href "/style.css"])))
          (body (form ([action ,results-url])
                      ,@(formlet-display username-formlet)
                      (input ([type "submit"])))))))

(define (get-username req)
  (define username (cookie-lookup req "username"))
  (or username
      (let ()
        (define username (formlet-process username-formlet (send/suspend username-form)))
        (define main (url->string (request-uri req)))
        (printf "~a\n" main)
        (send/back
         (redirect-to main see-other
                      #:headers (list (cookie->header (make-cookie "username" username))))))))


(define (start req)
  (define username (get-username req))
  (define maxes (formlet-process maxes-formlet (send/suspend max-form)))
  (response/xexpr
   `(html (head (title "fit2")
                (link ([rel "stylesheet"] [type "text/css"] [href "/style.css"])))
          (body
           ,@(for*/list ([week (in-range 4)]
                         [day (in-range (length (exercises)))])
               (plan-table day week maxes))))))

(serve/servlet start #:server-root-path ".")