parent and child posts properly returned by query; properly displayed

2 files changed, 82 insertions, 38 deletions

diff --git a/main.scm b/main.scm
index 10213a0..0519c3b 100644
--- a/main.scm
+++ b/main.scm
@@ -2,6 +2,7 @@
 (import spiffy intarweb uri-common html-parser (chicken port))
 (import (chicken io))
 (import sqlite3)
+(import sql-null)
 (import srfi-69)
 (import (chicken random))
 (import (chicken process-context))
@@ -25,10 +26,13 @@
                 )")
     )
 
-(define (create-post user content)
+(define (create-post user content parent-id)
   (let ([id (pseudo-random-integer 281474976710655)])
-    (execute db "insert into posts (id, user_id, content) values (?, ?, ?)"
-             id user content)))
+    (if (and parent-id (not (equal? "" parent-id)))
+      (execute db "insert into posts (id, user_id, content,parent_id) values (?, ?, ?, ?)"
+               id user content parent-id)
+      (execute db "insert into posts (id, user_id, content) values (?, ?, ?)"
+               id user content))))
 
 (define (vote-to-flush user)
     (execute db "insert or ignore into flush_votes (user_id) values (?)"
@@ -57,8 +61,8 @@
 (define (top-posts) (map-row list db
             "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                 FROM posts p
-                LEFT JOIN posts c ON c.id = p.parent_id
-                WHERE c.parent_id IS NULL
+                LEFT JOIN posts c ON c.parent_id = p.id
+                WHERE p.parent_id IS NULL
                 GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
                 ORDER BY count(c.id) DESC, p.created_at DESC LIMIT 25"))
 
@@ -68,7 +72,7 @@
   (first-row db 
                 "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                     FROM posts p
-                    LEFT JOIN posts c ON c.id = p.parent_id
+                    LEFT JOIN posts c ON c.parent_id = p.id
                     WHERE p.id = ?
                     GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
                     ORDER BY count(c.id) DESC LIMIT 1"
@@ -78,8 +82,8 @@
     (map-row list db
             "SELECT p.id, p.user_id, p.content, p.created_at, p.parent_id, count(c.id)
                 FROM posts p
-                LEFT JOIN posts c ON c.id = p.parent_id
-                WHERE c.parent_id IS ?
+                LEFT JOIN posts c ON c.parent_id = p.id
+                WHERE p.parent_id = ?
                 GROUP BY p.id, p.user_id, p.content, p.created_at, p.parent_id
                 ORDER BY count(c.id) DESC, p.created_at DESC LIMIT 25" post-id))
 
@@ -117,8 +121,7 @@
          [apikey (if cookie (cdr cookie) #f)])
     (if apikey (lookup-user apikey) #f)))
 
-(define (post current-user)
-  (lambda (p)
+(define (post current-user p)
     (let ([uri (string-append "/posts/" (id p))])
       `(div (@ [class "post"] [id ,(id p)])
             ,(if (equal? current-user (user p))
@@ -133,10 +136,14 @@
                        (a (@ [href ,uri] [style "margin-right:2px;"])
                           "[" ,(children-count p) " comments]")
                        ,(created-at p)
-                       ))))))
+                       )))))
 
-(define new-post-form
+(define (new-post-form parent-id)
   `(form (@ [class "new-post-form"] [action "/"] [method "POST"])
+         (input (@ [type "hidden"]
+                   [id "parent_id"]
+                   [name "parent_id"]
+                   [value ,(or parent-id "")]))
   (span 
       (textarea (@ [id "content"] [name "content"] [value ""] [rows "5"] [cols "50"])))
   (input (@ [id "submit"] [type "submit"] [value "Post"]))))
@@ -177,27 +184,56 @@
            (lambda (x) (equal? (second x) (string-append ":" param)))
            (zip path pattern)))))
 
-(define (posts-page current-user displayed-posts) (page
-                               `(div
-                                  (em "Even Shitter than Twitter")
-                                  (br)
-                                  ,(if current-user
-                                     (if (user-has-voted current-user)
-                                       '(a (@ [href "/unvote"]) unvote)
-                                       `(a (@ [href "/vote-to-flush"]) ,(vote-to-flush-prompt)))
-                                     '())
-                                  (div "Votes so far: " ,(vote-count))
-                                  (div
-                                    ,(if current-user
-                                       '(a (@ [style "float:right;"] [href "/logout"]) logout)
-                                       '(a (@ [style "float:right;"] [href "/login"]) login))
-                                    (h2 "Posts")
-                                    ,(if current-user new-post-form '())
-                                    ,(if (null? displayed-posts)
-                                       "No posts yet!"
-                                       (map (post current-user) displayed-posts))
-                                    )
-                                  )))
+(define (posts-page-outer current-user inner)
+  (page `(div
+           (em "Even Shitter than Twitter")
+           (br)
+           ,(if current-user
+              (if (user-has-voted current-user)
+                '(a (@ [href "/unvote"]) unvote)
+                `(a (@ [href "/vote-to-flush"]) ,(vote-to-flush-prompt)))
+              '())
+           (div "Votes so far: " ,(vote-count))
+           (div
+             ,inner))))
+
+(define (posts-page current-user displayed-posts)
+  (posts-page-outer current-user
+                    `(span
+                     ,(navbar current-user '(h2 "Posts"))
+                       ,(if current-user (new-post-form #f) '())
+                       ,(if (null? displayed-posts)
+                          "no posts yet!"
+                          (map (cut post current-user <>) displayed-posts))
+                       )))
+
+(define (navbar current-user . inner)
+  `(div (@ [class "navbar"])
+        ,(if current-user
+                '(a (@ [style "float:right;"] [href "/logout"]) logout)
+                '(a (@ [style "float:right;"] [href "/login"]) login))
+        ,inner
+       ))
+
+(define (post-page current-user p comments)
+  (let* ([pid (parent-id p)]
+        [parent-path (if (or (not pid)
+                            (sql-null? pid)
+                            (equal? pid ""))
+                       "/"
+                       (string-append "/posts/" pid))])
+    (posts-page-outer current-user
+                      `(span
+                         ,(navbar current-user
+                                  `(a (@ [href ,parent-path])
+                                      "return"))
+                      ,(post current-user p)
+                      (h3 "Comments")
+                      ,(if (null? comments)
+                         "no comments yet!"
+                         (map (cut post current-user <>) comments))
+                      ,(if current-user (new-post-form (id p)) '())))))
+
 
 (define routes
   `(
@@ -246,10 +282,15 @@
     (POST (/ "") ,(lambda (rt)
                     (let* ([form-data (read-urlencoded-request-data (current-request))]
                            [content (cdr (assv 'content form-data))]
+                           [parent-id (cdr (assv 'parent_id form-data))]
                            [user (get-current-user)]
-                           [success? (if user (create-post user content) #f)])
+                           [success? (if user (create-post user content parent-id) #f)])
                         (send-response
-                               headers: '((location "/"))
+                               headers: `((location ,(if
+                                                       (and parent-id
+                                                            (not (equal? "" parent-id)))
+                                                       (string-append "/posts/" parent-id)
+                                                       "/")))
                                status: 'see-other
                                ))))
     (GET (/ "") ,(lambda (rt) 
@@ -264,12 +305,11 @@
                               (let* ([current-user (get-current-user)]
                                      [post-id (get-route-param rt "id")]
                                      [post (get-post post-id)]
-                                     [comments (get-child-posts post-id)]
-                                     [displayed-posts (cons post comments)])
+                                     [comments (get-child-posts post-id)])
                                 (send-response
                                   headers: '((content-type text/html))
                                   status: 'ok
-                                  body: (posts-page current-user displayed-posts)))))
+                                  body: (post-page current-user post comments)))))
     ; Has method GET so that it can be used from <a> tag links
     (GET (/ "posts" ":id" "delete") ,(lambda (rt) 
                               (let* ([current-user (get-current-user)]
diff --git a/style.css b/style.css
index 503f976..2b8fc44 100644
--- a/style.css
+++ b/style.css
@@ -158,3 +158,7 @@ textarea {
     float:right;
     font-size:0.8em
 }
+
+.navbar {
+    height: 2em;
+}