yesod-comments 0.4.0 → 0.5.0
raw patch · 5 files changed
+95/−72 lines, 5 filesdep ~bytestringdep ~persistentdep ~yesod
Dependency ranges changed: bytestring, persistent, yesod, yesod-auth, yesod-form
Files
- Yesod/Comments.hs +9/−9
- Yesod/Comments/Core.hs +35/−26
- Yesod/Comments/Management.hs +29/−20
- Yesod/Comments/Storage.hs +16/−11
- yesod-comments.cabal +6/−6
Yesod/Comments.hs view
@@ -21,20 +21,20 @@ ) where import Yesod+import Yesod.Auth import Yesod.Comments.Core-import Yesod.Helpers.Auth -- | Comments that anyone can enter anonymously-addComments :: YesodComments m +addComments :: (RenderMessage m FormMessage, YesodComments m) => ThreadId -- ^ the thread you're adding comments to -> GWidget s m () addComments tid = do comments <- lift $ loadComments (Just tid)- ((res, form), enctype) <- lift $ runFormMonadPost commentForm+ ((res, form), enctype) <- lift $ runFormPost commentForm handleForm res tid addStyling- [hamlet|+ [whamlet| <div .yesod_comments> <h4>Add a comment: <div .yesod_comment_input>@@ -50,7 +50,7 @@ |] -- | Comments that require authentication-addCommentsAuth :: (YesodAuth m, YesodComments m)+addCommentsAuth :: (RenderMessage m FormMessage, YesodAuth m, YesodComments m) => ThreadId -- ^ the thread you're adding comments to -> GWidget s m () addCommentsAuth tid = do@@ -64,11 +64,11 @@ return (True, toSinglePiece uid, uname, email) comments <- lift $ loadComments (Just tid)- ((res, form), enctype) <- lift $ runFormMonadPost $ commentFormAuth uid username email+ ((res, form), enctype) <- lift $ runFormPost (commentFormAuth uid username email) handleForm res tid addStyling- [hamlet|+ [whamlet| <div .yesod_comments> $if isAuthenticated <h4>Add a comment:@@ -96,5 +96,5 @@ lift $ setUltDest' -- so we come back here after login mroute <- lift $ fmap authRoute getYesod case mroute of- Just r -> [hamlet|<a href="@{r}">log in|]- Nothing -> [hamlet|log in|]+ Just r -> [whamlet|<a href="@{r}">log in|]+ Nothing -> [whamlet|log in|]
Yesod/Comments/Core.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} ------------------------------------------------------------------------------- -- | -- Module : Yesod.Comments.Core@@ -31,8 +32,7 @@ ) where import Yesod-import Yesod.Form.Core-import Yesod.Helpers.Auth+import Yesod.Auth import Yesod.Goodies.Gravatar import Yesod.Goodies.Markdown import Yesod.Goodies.Time@@ -112,12 +112,13 @@ } -- | The comment form itself-commentForm :: GFormMonad s m (FormResult CommentForm, GWidget s m ())-commentForm = do- (user , fiUser ) <- stringField "name:" Nothing- (email , fiEmail ) <- emailField "email:" Nothing- (comment, fiComment) <- markdownField "comment:" Nothing- return (CommentForm <$> user <*> email <*> comment <*> FormSuccess False, [hamlet|+commentForm :: RenderMessage m FormMessage => Html -> Form s m (FormResult CommentForm, GWidget s m ())+commentForm fragment = do+ (user , fiUser ) <- mreq textField "name:" Nothing+ (email , fiEmail ) <- mreq emailField "email:" Nothing+ (comment, fiComment) <- mreq markdownField "comment:" Nothing+ return (CommentForm <$> user <*> email <*> comment <*> FormSuccess False, [whamlet|+ #{fragment} <table> ^{fieldRow fiUser} ^{fieldRow fiEmail}@@ -130,15 +131,18 @@ -- | The comment form if using authentication (uid is hidden and display -- name is shown)-commentFormAuth :: T.Text -- ^ text version of uid+commentFormAuth :: RenderMessage m FormMessage+ => 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+ -> Html -- ^ nonce fragment+ -> Form s m (FormResult CommentForm, GWidget s m ())+commentFormAuth user username email fragment = do let img = gravatarImg email defaultOptions { gDefault = Just MM } - (fComment, fiComment) <- markdownField "comment:" Nothing- return (CommentForm <$> FormSuccess user <*> FormSuccess email <*> fComment <*> FormSuccess True, [hamlet|+ (fComment, fiComment) <- mreq markdownField "comment:" Nothing+ return (CommentForm <$> FormSuccess user <*> FormSuccess email <*> fComment <*> FormSuccess True, [whamlet|+ #{fragment} <div .yesod_comment_avatar_input> <a title="change your profile picture at gravatar" href="http://gravatar.com/emails/"> <img src="#{img}">@@ -156,10 +160,14 @@ |]) -- | The comment form used in the management edit page.-commentFormEdit :: Comment -> GFormMonad s m (FormResult CommentForm, GWidget s m ())-commentFormEdit comment = do- (fComment, fiComment) <- markdownField "comment:" (Just $ content comment)- return (CommentForm <$> FormSuccess "" <*> FormSuccess "" <*> fComment <*> FormSuccess True, [hamlet|+commentFormEdit :: RenderMessage m FormMessage+ => Comment+ -> Html+ -> Form s m (FormResult CommentForm, GWidget s m ())+commentFormEdit comment fragment = do+ (fComment, fiComment) <- mreq markdownField "comment:" (Just $ content comment)+ return (CommentForm <$> FormSuccess "" <*> FormSuccess "" <*> fComment <*> FormSuccess True, [whamlet|+ #{fragment} <table> ^{fieldRow fiComment} <tr>@@ -168,23 +176,24 @@ <input type="submit" value="Update comment"> |]) -fieldRow :: FieldInfo s m -> GWidget s m ()-fieldRow fi = [hamlet|- <tr .#{clazz fi}>+fieldRow :: FieldView s m -> GWidget s m ()+fieldRow fv = [whamlet|+ <tr .#{clazz fv}> <th>- <label for="#{fiIdent fi}">#{fiLabel fi}- <div .tooltip>#{fiTooltip fi}+ <label for="#{fvId fv}">#{fvLabel fv}+ $maybe tt <- fvTooltip fv+ <div .tooltip>#{tt} <td>- ^{fiInput fi}+ ^{fvInput fv} <td>- $maybe error <- fiErrors fi+ $maybe error <- fvErrors fv #{error} $nothing |] -clazz :: FieldInfo s m -> String-clazz fi = if fiRequired fi then "required" else "optional"+clazz :: FieldView s m -> String+clazz fv = if fvRequired fv then "required" else "optional" -- | Add some cassius that is common to all the yesod-comments pages addStyling :: Yesod m => GWidget s m ()
Yesod/Comments/Management.hs view
@@ -30,7 +30,6 @@ -- comment entirely. -- -------------------------------------------------------------------------------- module Yesod.Comments.Management ( CommentsAdmin , CommentsAdminRoute(..)@@ -38,7 +37,7 @@ ) where import Yesod-import Yesod.Helpers.Auth+import Yesod.Auth import Yesod.Comments.Core import Yesod.Goodies.Markdown import Control.Monad (forM, unless)@@ -69,7 +68,7 @@ defaultLayout $ do setTitle "Comments administration" addStyling- [hamlet|+ [whamlet| <h1>Comments overview <article .yesod_comments_overview> $if null threads@@ -84,7 +83,7 @@ defaultLayout $ do setTitle "View comment" addStyling- [hamlet|+ [whamlet| <h1>View comment <article .yesod_comments_view_comment> <table>@@ -117,12 +116,12 @@ getEditR :: (YesodAuth m, YesodComments m) => ThreadId -> CommentId -> GHandler CommentsAdmin m RepHtml getEditR tid cid = withUserComment tid cid $ \comment -> do tm <- getRouteToMaster- ((res, form), enctype) <- runFormMonadPost $ commentFormEdit comment+ ((res, form), enctype) <- runFormPost $ commentFormEdit comment defaultLayout $ do setTitle "Edit comment" handleFormEdit (tm OverviewR) res comment addStyling- [hamlet|+ [whamlet| <h1>Edit comment <article .yesod_comments_edit_comment> <h3>Update comment@@ -144,29 +143,39 @@ getThreadedComments :: (YesodAuth m, YesodComments m) => GHandler s m [(ThreadId, [Comment])] getThreadedComments = do allComments <- loadComments Nothing- comments' <- forM allComments $ \comment -> do- check <- isCommentingUser comment- return $ if check then [comment] else []-- let comments = concat comments'+ allThreads <- forM allComments $ \comment -> do+ mine <- isCommentingUser comment+ return $ if mine then [threadId comment] else [] - forM (sort . nub $ map threadId comments) $ \tid ->- return $ (tid, filter ((== tid) . threadId) comments)+ forM (sort . nub $ concat allThreads) $ \tid ->+ return (tid, filter ((== tid) . threadId) allComments) showThreadedComments :: (YesodAuth m, YesodComments m) => (ThreadId, [Comment]) -> GWidget CommentsAdmin m ()-showThreadedComments (tid, comments) = [hamlet|+showThreadedComments (tid, comments) = [whamlet| <div .yesod_comments_overview_thread> <h3>#{tid} $forall comment <- comments- <div .yesod_comments_overview_comment>- ^{showCommentAuth comment}- ^{updateLinks comment}+ ^{showThreadComment comment} |] + where+ showThreadComment :: (YesodAuth m, YesodComments m) => Comment -> GWidget CommentsAdmin m ()+ showThreadComment comment = do+ mine <- lift $ isCommentingUser comment+ [whamlet|+ $if mine+ <div .yesod_comments_overview_comment_yours>+ ^{showCommentAuth comment}+ ^{updateLinks comment}+ $else+ <div .yesod_comments_overview_comment>+ ^{showCommentAuth comment}+ |]+ updateLinks :: (YesodAuth m, YesodComments m) => Comment -> GWidget CommentsAdmin m () updateLinks (Comment tid cid _ _ _ _ _ _ )= do tm <- lift $ getRouteToMaster- [hamlet|+ [whamlet| <div .yesod_comments_update_links> <p> <a href=@{tm $ ViewR tid cid}>View@@ -189,8 +198,8 @@ case mcomment of Just comment -> do _ <- requireAuthId- check <- isCommentingUser comment- unless check $ permissionDenied "you can only manage your own comments"+ mine <- isCommentingUser comment+ unless mine $ permissionDenied "you can only manage your own comments" f comment Nothing -> notFound
Yesod/Comments/Storage.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -44,10 +45,14 @@ -- | Create the required types and migration function for use in a -- general yesod app-share2 mkPersist (mkMigrate "migrateComments") [persist|+--+-- todo: find out how to do the ThreadId/CommentId types with the new+-- persistent module+--+share [mkPersist sqlSettings, mkMigrate "migrateComments"] [persist| SqlComment- threadId ThreadId Eq noreference- commentId CommentId Eq Asc noreference+ threadId T.Text Eq noreference+ commentId Int Eq Asc noreference timeStamp UTCTime ipAddress T.Text userName T.Text@@ -83,27 +88,27 @@ , isAuth = sqlCommentIsAuth sqlComment } -getCommentPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => ThreadId -> CommentId -> GHandler s m (Maybe Comment)+getCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => ThreadId -> CommentId -> GHandler s m (Maybe Comment) getCommentPersist tid cid = return . fmap (fromSqlComment . snd) =<< runDB (getBy $ UniqueSqlComment tid cid) -storeCommentPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => Comment -> GHandler s m ()+storeCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> GHandler s m () storeCommentPersist c = return . const () =<< runDB (insert $ toSqlComment c) -- | Note, only updates the content record-updateCommentPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => Comment -> Comment -> GHandler s m ()+updateCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> Comment -> GHandler s m () updateCommentPersist (Comment tid cid _ _ _ _ _ _) (Comment _ _ _ _ _ _ newContent _) = do mres <- runDB (getBy $ UniqueSqlComment tid cid) case mres of- Just (k,_) -> runDB $ update k [SqlCommentContent newContent]+ Just (k,_) -> runDB $ update k [SqlCommentContent =. newContent] _ -> return () -deleteCommentPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => Comment -> GHandler s m ()+deleteCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> GHandler s m () deleteCommentPersist c = return . const () =<< runDB (deleteBy $ UniqueSqlComment (threadId c) (commentId c)) -- | Use @'Nothing'@ to retrieve all comments site-wide-loadCommentsPersist :: (YesodPersist m, PersistBackend (YesodDB m (GGHandler s m IO))) => Maybe ThreadId -> GHandler s m [Comment]-loadCommentsPersist (Just tid) = return . fmap (fromSqlComment . snd) =<< runDB (selectList [SqlCommentThreadIdEq tid] [SqlCommentCommentIdAsc] 0 0)-loadCommentsPersist Nothing = return . fmap (fromSqlComment . snd) =<< runDB (selectList [] [SqlCommentCommentIdAsc] 0 0)+loadCommentsPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Maybe ThreadId -> GHandler s m [Comment]+loadCommentsPersist (Just tid) = return . fmap (fromSqlComment . snd) =<< runDB (selectList [SqlCommentThreadId ==. tid] [Asc SqlCommentCommentId])+loadCommentsPersist Nothing = return . fmap (fromSqlComment . snd) =<< runDB (selectList [] [Asc SqlCommentCommentId]) -- $todo --
yesod-comments.cabal view
@@ -1,5 +1,5 @@ name: yesod-comments-version: 0.4.0+version: 0.5.0 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@@ -21,13 +21,13 @@ -- Packages needed in order to build this package. build-depends: base >= 4 && < 5 , text >= 0.11 && < 0.12- , bytestring >= 0.9.1 && < 10.0+ , bytestring >= 0.9.1 && < 0.10 , wai >= 0.4 && < 0.5- , yesod >= 0.8 && < 0.9- , yesod-form >= 0.1 && < 0.2- , yesod-auth >= 0.4 && < 0.5+ , yesod >= 0.9 && < 1.0+ , yesod-form >= 0.3 && < 0.4+ , yesod-auth >= 0.7 && < 0.8 , yesod-goodies >= 0.0.3 && < 0.1- , persistent >= 0.5 && < 0.6+ , persistent >= 0.6 && < 0.7 , template-haskell , directory , time