Commit 540b4c65 authored by amirouche's avatar amirouche

web: quick'n'dirty message display

- '/item/uid/' add it

- '/' display messages
parent 7bf8df4b
......@@ -87,6 +87,8 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(define (grf3:find key value) ;; TODO: move to wiredtiger
(map grf3:get (fs:find key value)))
(define grf3:vertex? (@@ (wiredtiger grf3) vertex?))
;;; alist helpers using equal?
(define (rm alist key)
......@@ -202,7 +204,7 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(grf3:create-vertex `((type . item)
(subtype . message)
(created-at . ,(current-time))
(body . ,body))))))
(message/body . ,body))))))
(grf3:save (grf3:create-edge message user `((type . created-by))))
message)))
......@@ -243,6 +245,10 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(("/signin") (redirect "/signin"))
(("/signup") (redirect "/signup")))))
(define (items/sxml)
(let ((items (grf3:find 'type 'item))) ;; TODO: order by created-at
(map (lambda (item) ((subtype-sxml (grf3:vertex-ref item 'subtype)) item)) items)))
(define (index app request)
(let ((query (assoc-ref (request-query request) "query"))
(user (request-user request app)))
......@@ -260,9 +266,9 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(autofocus #t)))
(input (@ (type "submit")
(value "submit"))))
(div (@ (id "overview-intro"))
,(lorem-ipsum 100))
,(map random-item (iota 10))))))))))
;; (div (@ (id "overview-intro"))
;; ,(lorem-ipsum 100))
,(items/sxml)))))))))
;;; form helpers
......@@ -493,6 +499,25 @@ user vertex"
(redirect "/signin"))
(sxml->response (signup/template form errors))))))
;;; item
(define (message/sxml message)
`(div (@ (class "item-message"))
(p ,(grf3:vertex-ref message 'message/body))
(p (@ (class "created-at")) ,(grf3:vertex-ref message 'created-at))))
(define (subtype-sxml subtype)
(case subtype
((message) message/sxml)
(else (throw 'culturia (format #f "subtype ~s not supported yet" subtype)))))
(define (route/item/get request uid)
(let ((item (grf3:get uid)))
(if (and (grf3:vertex? item) (not (eq? (grf3:vertex-ref item 'type) 'user)))
(let ((item/sxml (subtype-sxml (grf3:vertex-ref item 'subtype))))
(sxml->response (template "item" (item/sxml item))))
(not-found (uri-path (request-uri request))))))
(define (handler app request body)
(log-debug "~a ~a" (request-method request) (uri-path (request-uri request)))
(with-context*
......@@ -506,6 +531,7 @@ user vertex"
('(POST "signin") (signin/post app request body))
('(GET "signup") (signup/get request))
('(POST "signup") (signup/post app request body))
(`(GET "item" ,uid) (route/item/get request uid))
('(GET "message" "create") (route/message-create/get app request))
('(POST "message" "create") (route/message-create/post app request body))
(('GET "static" path ...) (render-static-asset path))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment