Commits

Luke Plant committed 2ba5e75

Minimal working comment form.

  • Participants
  • Parent commits 5db85a6

Comments (0)

Files changed (3)

File src/Blog/Forms.hs

 import Ella.Forms.Widgets.Textarea  (Textarea(..))
 import qualified Ella.Forms.Widgets.TextInput as TI
 import qualified Ella.Forms.Widgets.Textarea as TA
+import Ella.Param (captureOrDefault)
+
 import qualified Blog.Comment as Cm
 import qualified Blog.Post as P
 import Blog.Formats (plaintext)
 
 import Data.Maybe (fromJust)
 import System.Posix.Time (epochTime)
-
+import System.Posix.Types
 
 nameWidget = TextInput { value = ""
                        , size = Just 20
                     deriving (Eq, Ord, Enum, Read, Show)
 
 
+-- | An empty comment used for populating the default form.
+emptyComment = Cm.Comment {
+                 uid = undefined
+               , post_id = undefined
+               , timestamp = undefined
+               , name = ""
+               , email = ""
+               , text_raw = ""
+               , text_formatted = undefined
+               , format_id = undefined
+               }
+
+
 -- | extract the posted data from a POST request and build
 -- a Comment from it, returning a Comment and a list of validaion errors
 validateComment postedData blogpost =
     -- TODO - actual validation on fields
     -- TODO - addCommentToPost utility
       ts <- epochTime
-      let text = fromJust $ postedData "message"
-      let errors = []
+      let text = postedData "message" `captureOrDefault` ""
+      let name = postedData "name" `captureOrDefault` ""
+      let email = postedData "email" `captureOrDefault` ""
+      let errors = (if null text
+                   then ["'Message' is a required field."]
+                   else [])
+                   ++
+                   (if null name
+                   then ["'Name' is a required field."]
+                   else [])
+
       return (Cm.Comment {
-                      Cm.uid = undefined
-                    , Cm.post_id = P.uid blogpost
-                    , Cm.timestamp = ts
-                    , Cm.name = fromJust $ Map.lookup "name" postedData
-                    , Cm.email = fromJust $ Map.lookup "name" postedData
-                    , Cm.text_raw = text
-                    , Cm.text_formatted = text -- TODO fix, security
-                    , Cm.format_id = plaintext
+                      uid = undefined
+                    , post_id = P.uid blogpost
+                    , timestamp = floor $ toRational ts
+                    , name = name
+                    , email = email
+                    , text_raw = text
+                    , text_formatted = text -- TODO fix, security
+                    , format_id = plaintext
                     }, errors)
 

File src/Blog/Templates.hs

 import Blog.Forms (emailWidget, nameWidget, messageWidget, CommentStage(..))
 import Blog.Links
 import Ella.Forms.Widgets (makeLabel)
+import Ella.Forms.Base
 import Data.List (intersperse)
 import Text.XHtml
 import qualified Blog.Post as P
          -> Html
 postPage post commentStage commentData commentErrors categories comments related =
     page $ defaultPageVars
-             { pcontent = formatPost post categories comments related
+             { pcontent = formatPost post commentStage commentData commentErrors categories comments related
              , ptitle = P.title post
              }
 
-formatPost post categories comments otherposts =
+formatPost post commentStage commentData commentErrors categories comments otherposts =
     (h1 ! [theclass "posttitle"] << P.title post
      +++
      metaInfoLine post categories "metainfo"
       then (thediv ! [identifier "addcomment"]
             << ((h1 << "Add comment:")
                 +++
-                commentForm post
+                commentForm post commentStage commentData commentErrors
                )
            )
       else (hr +++ p << "Closed for comments.")
      )
     )
 
-commentForm post =
+commentForm post commentStage commentData errors =
+    (case commentStage of
+       CommentPreview ->
+           (h2 << "Preview")
+           +++
+           (thediv ! [theclass "commentpreview"]
+            <<
+            formatComment commentData)
+
+       CommentAccepted ->
+           (thediv ! [theclass "accepted"]
+            << "Comment added, thank you.")
+
+       CommentInvalid ->
+           (thediv ! [theclass "validationerror"]
+            << unordList errors)
+
+       _ -> noHtml
+    )
+    +++
     form ! [method "post", action "#addcomment"]
     << (
         (table <<
           (tr <<
            (td << makeLabel "Name:" nameWidget
             +++
-            td << nameWidget
+            td << setVal (Cm.name commentData) nameWidget
            ))
           +++
           (tr <<
            (td << makeLabel "Email:" emailWidget
             +++
-            td << emailWidget
+            td << setVal (Cm.email commentData) emailWidget
            ))))
         +++
-        messageWidget
+        setVal (Cm.text_raw commentData) messageWidget
         +++
         br
         +++
-        (submit "post" "Post")
+        (submit "submit" "Post")
         +++
         (submit "preview" "Preview")
        )

File src/Blog/Views.hs

 import Blog.Links
 import Blog.DB (connect)
 import Blog.Model
-import Blog.Forms (CommentStage(..), validateComment)
+import Blog.Forms (CommentStage(..), validateComment, emptyComment)
+
 import Maybe (fromMaybe, isJust)
 
 ---- Utilities
         case requestMethod req of
           "POST" -> do
             (commentData, commentErrors) <- validateComment (getPOST req) post
-            commentStage <-
-                do
-                  if isJust (getPOST req "submit")
-                     then if null commentErrors
-                          then
-                              do
-                                addComment cn commentData
-                                return CommentAccepted
-                          else
-                              return CommentInvalid
-                     -- Just assume 'preview' if not 'submit'
-                     else return CommentPreview
-            return (commentStage, commentData, commentErrors)
+            if null commentErrors
+               then if isJust (getPOST req "submit")
+                    then
+                        do
+                          addComment cn commentData
+                          return (CommentAccepted, emptyComment, [])
+                          -- Just assume 'preview' if not 'submit'
+                    else return (CommentPreview, commentData, commentErrors)
+               else
+                   return (CommentInvalid, commentData, commentErrors)
 
-          _ -> return (NoComment, undefined, undefined)
+          _ -> return (NoComment, emptyComment, [])
 
 
 -- | View that shows a post as a static information page -- no comments etc.