yesod-comments 0.3.3 → 0.3.4
raw patch · 4 files changed
+39/−35 lines, 4 files
Files
- Yesod/Comments.hs +4/−4
- Yesod/Comments/Core.hs +31/−30
- Yesod/Comments/Storage.hs +3/−0
- yesod-comments.cabal +1/−1
Yesod/Comments.hs view
@@ -107,10 +107,10 @@ |] -- | Handle the posted form and actually insert the comment-handleForm :: YesodComments m - => FormResult CommentForm - -> ThreadId - -> CommentId +handleForm :: YesodComments m+ => FormResult CommentForm+ -> ThreadId+ -> CommentId -> GWidget s m () handleForm res tid cid = case res of FormMissing -> return ()
Yesod/Comments/Core.hs view
@@ -77,12 +77,14 @@ , userName :: T.Text , userEmail :: T.Text , content :: Markdown+ , isAuth :: Bool } data CommentForm = CommentForm { formUser :: T.Text , formEmail :: T.Text , formComment :: Markdown+ , formIsAuth :: Bool } -- | Cleanse form input and create a 'Comment' to be stored@@ -95,9 +97,10 @@ , commentId = cid , timeStamp = now , ipAddress = T.pack ip- , userName = formUser cf- , userEmail = formEmail cf+ , userName = formUser cf+ , userEmail = formEmail cf , content = formComment cf+ , isAuth = formIsAuth cf } -- | The comment form itself@@ -106,7 +109,7 @@ (user , fiUser ) <- stringField "name:" Nothing (email , fiEmail ) <- emailField "email:" Nothing (comment, fiComment) <- markdownField "comment:" Nothing- return (CommentForm <$> user <*> email <*> comment, [hamlet|+ return (CommentForm <$> user <*> email <*> comment <*> FormSuccess False, [hamlet| <table> ^{fieldRow fiUser} ^{fieldRow fiEmail}@@ -119,32 +122,20 @@ -- | The comment form if using authentication (uid is hidden and display -- name is shown)-commentFormAuth :: T.Text -> T.Text -> T.Text -> GFormMonad s m (FormResult CommentForm, GWidget s m ())-commentFormAuth uid username email = do- (user , fiUser ) <- hiddenField "name:" (Just uid)- (email' , fiEmail ) <- hiddenField "email:" (Just email)- (comment, fiComment) <- markdownField "comment:" Nothing-- let img = gravatarImg email defaultOptions+commentFormAuth :: T.Text -- ^ text version of uid+ -> T.Text -- ^ friendly name+ -> T.Text -- ^ email+ -> GFormMonad s m (FormResult CommentForm, GWidget s m ())+commentFormAuth user username email = do+ let img = gravatarImg email defaultOptions { gDefault = Just MM } - return (CommentForm <$> user <*> email' <*> comment, [hamlet|+ (comment, fiComment) <- markdownField "comment:" Nothing+ return (CommentForm <$> FormSuccess user <*> FormSuccess email <*> comment <*> FormSuccess True, [hamlet| <div .yesod_comment_avatar_input> <a title="change your profile picture at gravatar" href="http://gravatar.com/emails/"> <img src="#{img}"> <table>- <tr style="display: none;">- <th>- <label for="#{fiIdent fiUser}"> - <td colspan="2">- ^{fiInput fiUser}-- <tr style="display: none;">- <th>- <label for="#{fiIdent fiEmail}"> - <td colspan="2">- ^{fiInput fiEmail}- <tr> <th>name: <td colspan="2">#{username}@@ -156,6 +147,7 @@ <input type="submit" value="Add comment"> |]) + fieldRow :: FieldInfo s m -> GWidget s m () fieldRow fi = [hamlet| <tr .#{clazz fi}>@@ -176,22 +168,31 @@ -- | Show a single comment showComment :: Yesod m => Comment -> GWidget s m ()-showComment comment = showHelper comment $ userName comment+showComment comment = showHelper comment (userName comment, userEmail comment) -- | Show a single comment, auth version showCommentAuth :: (Yesod m, YesodAuth m, YesodComments m) => Comment -> GWidget s m () showCommentAuth comment = do let cusername = userName comment- case fromSinglePiece $ cusername of- Nothing -> showHelper comment cusername- Just uid -> showHelper comment =<< lift (displayUser uid) + (cuname, cemail) <-+ if isAuth comment+ then case fromSinglePiece $ cusername of+ Just uid -> do+ uname <- lift $ displayUser uid+ email <- lift $ displayEmail uid+ return (uname, email)+ _ -> return (cusername, userEmail comment)+ else return (cusername, userEmail comment)++ showHelper comment (cuname, cemail)+ -- | Factor out common code-showHelper :: Yesod m => Comment -> T.Text -> GWidget s m ()-showHelper comment username = do+showHelper :: Yesod m => Comment -> (T.Text,T.Text) -> GWidget s m ()+showHelper comment (username, email) = do commentTimestamp <- lift . humanReadableTime $ timeStamp comment let anchor = "#comment_" ++ show (commentId comment)- let img = gravatarImg (userEmail comment) defaultOptions { gSize = Just $ Size 20 }+ let img = gravatarImg email defaultOptions { gDefault = Just MM, gSize = Just $ Size 20 } addHamlet [hamlet| <div .yesod_comment_avatar_list> <img src="#{img}">
Yesod/Comments/Storage.hs view
@@ -52,6 +52,7 @@ userName T.Text userEmail T.Text content Markdown+ isAuth Bool UniqueSqlComment threadId commentId |] @@ -65,6 +66,7 @@ , sqlCommentUserName = userName comment , sqlCommentUserEmail = userEmail comment , sqlCommentContent = content comment+ , sqlCommentIsAuth = isAuth comment } -- | Read a 'Comment' back from a selected 'SqlComment'@@ -77,6 +79,7 @@ , userName = sqlCommentUserName sqlComment , userEmail = sqlCommentUserEmail sqlComment , content = sqlCommentContent sqlComment+ , isAuth = sqlCommentIsAuth sqlComment } getCommentPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => ThreadId -> CommentId -> GHandler s m (Maybe Comment)
yesod-comments.cabal view
@@ -1,5 +1,5 @@ name: yesod-comments-version: 0.3.3+version: 0.3.4 synopsis: A generic comments interface for a Yesod application description: A generic comments interface for a Yesod application homepage: http://github.com/pbrisbin/yesod-comments