posts + comments

Author: mo-sqrd

Application/Migration/1761002795.sql

@@ -0,0 +1,8 @@
+CREATE TABLE comments (
+    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+    post_id UUID NOT NULL,
+    author TEXT NOT NULL,
+    body TEXT NOT NULL
+);
+CREATE INDEX comments_post_id_index ON comments (post_id);
+ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE NO ACTION;

Application/Migration/1761008261.sql

@@ -0,0 +1 @@
+ALTER TABLE comments RENAME COLUMN authos TO author;

Application/Migration/1761008798.sql

@@ -0,0 +1,2 @@
+ALTER TABLE comments ADD COLUMN created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL;
+CREATE INDEX comments_created_at_index ON comments (created_at);

Application/Schema.sql

@@ -6,3 +6,13 @@ CREATE TABLE posts (
     created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
 );
 CREATE INDEX posts_created_at_index ON posts (created_at);
+CREATE TABLE comments (
+    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+    post_id UUID NOT NULL,
+    author TEXT NOT NULL,
+    body TEXT NOT NULL,
+    created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
+);
+CREATE INDEX comments_post_id_index ON comments (post_id);
+CREATE INDEX comments_created_at_index ON comments (created_at);
+ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE NO ACTION;

Web/Controller/Comments.hs

@@ -0,0 +1,60 @@
+module Web.Controller.Comments where
+
+import Web.Controller.Prelude
+import Web.View.Comments.Index
+import Web.View.Comments.New
+import Web.View.Comments.Edit
+import Web.View.Comments.Show
+
+instance Controller CommentsController where
+    action CommentsAction = do
+        comments <- query @Comment |> fetch
+        render IndexView { .. }
+
+    action NewCommentAction { postId } = do
+        let comment = newRecord
+                |> set #postId postId
+        post <- fetch postId
+        render NewView { .. }
+
+    action ShowCommentAction { commentId } = do
+        comment <- fetch commentId
+        render ShowView { .. }
+
+    action EditCommentAction { commentId } = do
+        comment <- fetch commentId
+        render EditView { .. }
+
+    action UpdateCommentAction { commentId } = do
+        comment <- fetch commentId
+        comment
+            |> buildComment
+            |> ifValid \case
+                Left comment -> render EditView { .. }
+                Right comment -> do
+                    comment <- comment |> updateRecord
+                    setSuccessMessage "Comment updated"
+                    redirectTo EditCommentAction { .. }
+
+    action CreateCommentAction = do
+        let comment = newRecord @Comment
+        comment
+            |> buildComment
+            |> ifValid \case
+                Left comment -> do
+                    post <- fetch comment.postId -- <---- NEW
+                    render NewView { .. }
+                Right comment -> do
+                    comment <- comment |> createRecord
+                    setSuccessMessage "Comment created"
+                    redirectTo ShowPostAction { postId = comment.postId }
+
+
+    action DeleteCommentAction { commentId } = do
+        comment <- fetch commentId
+        deleteRecord comment
+        setSuccessMessage "Comment deleted"
+        redirectTo CommentsAction
+
+buildComment comment = comment
+    |> fill @'["postId", "author", "body"]

Web/Controller/Posts.hs

@@ -5,6 +5,8 @@ import Web.View.Posts.Index
 import Web.View.Posts.New
 import Web.View.Posts.Edit
 import Web.View.Posts.Show
+import qualified Text.MMark as MMark
+
 
 instance Controller PostsController where
     action PostsAction = do
@@ -19,6 +21,8 @@ instance Controller PostsController where
 
     action ShowPostAction { postId } = do
         post <- fetch postId
+            >>= pure . modify #comments (orderByDesc #createdAt)
+            >>= fetchRelated #comments
         render ShowView { .. }
 
     action EditPostAction { postId } = do
@@ -56,3 +60,11 @@ instance Controller PostsController where
 buildPost post = post
     |> fill @'["title", "body"]
     |> validateField #title nonEmpty
+    |> validateField #body nonEmpty
+    |> validateField #body isMarkdown
+
+isMarkdown :: Text -> ValidatorResult
+isMarkdown text =
+    case MMark.parse "" text of
+        Left _ -> Failure "Please provide valid Markdown"
+        Right _ -> Success

Web/FrontController.hs

@@ -5,13 +5,15 @@ import Web.Controller.Prelude
 import Web.View.Layout (defaultLayout)
 
 -- Controller Imports
+import Web.Controller.Comments
 import Web.Controller.Posts
 import Web.Controller.Static
 
 instance FrontController WebApplication where
     controllers = 
         [ startPage WelcomeAction
         -- Generator Marker
+        , parseRoute @CommentsController
         , parseRoute @PostsController
         ]
 

Web/Routes.hs

@@ -7,3 +7,6 @@ import Web.Types
 instance AutoRoute StaticController
 instance AutoRoute PostsController
 
+
+instance AutoRoute CommentsController
+

Web/Types.hs

@@ -18,3 +18,13 @@ data PostsController
     | UpdatePostAction { postId :: !(Id Post) }
     | DeletePostAction { postId :: !(Id Post) }
     deriving (Eq, Show, Data)
+
+data CommentsController
+    = CommentsAction
+    | NewCommentAction { postId :: !(Id Post) } 
+    | ShowCommentAction { commentId :: !(Id Comment) }
+    | CreateCommentAction
+    | EditCommentAction { commentId :: !(Id Comment) }
+    | UpdateCommentAction { commentId :: !(Id Comment) }
+    | DeleteCommentAction { commentId :: !(Id Comment) }
+    deriving (Eq, Show, Data)

Web/View/Comments/Edit.hs

@@ -0,0 +1,25 @@
+module Web.View.Comments.Edit where
+import Web.View.Prelude
+
+data EditView = EditView { comment :: Comment }
+
+instance View EditView where
+    html EditView { .. } = [hsx|
+        {breadcrumb}
+        <h1>Edit Comment</h1>
+        {renderForm comment}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "Comments" CommentsAction
+                , breadcrumbText "Edit Comment"
+                ]
+
+renderForm :: Comment -> Html
+renderForm comment = formFor comment [hsx|
+    {(textField #postId)}
+    {(textField #author)}
+    {(textField #body)}
+    {submitButton}
+
+|]