yesod-comments 0.5.0 → 0.7
raw patch · 5 files changed
+231/−275 lines, 5 filesdep +friendly-timedep +gravatardep +yesod-markdowndep −yesod-goodiesdep ~persistentdep ~waidep ~yesod
Dependencies added: friendly-time, gravatar, yesod-markdown
Dependencies removed: yesod-goodies
Dependency ranges changed: persistent, wai, yesod, yesod-auth, yesod-form
Files
- Yesod/Comments.hs +44/−38
- Yesod/Comments/Core.hs +105/−191
- Yesod/Comments/Management.hs +55/−23
- Yesod/Comments/Storage.hs +14/−13
- yesod-comments.cabal +13/−10
Yesod/Comments.hs view
@@ -4,9 +4,9 @@ ------------------------------------------------------------------------------- -- | -- Module : Yesod.Comments--- Copyright : (c) Patrick Brisbin 2010 +-- Copyright : (c) Patrick Brisbin 2010 -- License : as-is--- Maintainer : pbrisbin@gmail.com +-- Maintainer : pbrisbin@gmail.com -- Stability : unstable -- Portability : unportable --@@ -23,6 +23,8 @@ import Yesod import Yesod.Auth import Yesod.Comments.Core+import Network.Gravatar+import Data.Text (Text) -- | Comments that anyone can enter anonymously addComments :: (RenderMessage m FormMessage, YesodComments m)@@ -33,20 +35,16 @@ ((res, form), enctype) <- lift $ runFormPost commentForm handleForm res tid- addStyling+ [whamlet| <div .yesod_comments>- <h4>Add a comment:- <div .yesod_comment_input>- <form enctype="#{enctype}" method="post">^{form}- <p .helptext>Comments are parsed as pandoc-style markdown-- $if not $ null comments- <h4>Showing #{toHtml $ helper $ length comments}:-- $forall comment <- comments- <div .yesod_comment>^{showComment comment}+ ^{showComments comments showComment} + <div .input>+ <form enctype="#{enctype}" method="post" .form-stacked>+ ^{form}+ <div .actions>+ <button .btn .primary type="submit">Add comment |] -- | Comments that require authentication@@ -61,40 +59,48 @@ Just uid -> do uname <- displayUser uid email <- displayEmail uid- return (True, toSinglePiece uid, uname, email)+ return (True, toPathPiece uid, uname, email) comments <- lift $ loadComments (Just tid)- ((res, form), enctype) <- lift $ runFormPost (commentFormAuth uid username email)+ ((res, form), enctype) <- lift $ runFormPost (commentFormAuth uid email) handleForm res tid- addStyling+ [whamlet| <div .yesod_comments>+ ^{showComments comments showCommentAuth}+ $if isAuthenticated- <h4>Add a comment:- <div .yesod_comment_input>- <form enctype="#{enctype}" method="post">^{form}- <p .helptext>Comments are parsed as pandoc-style markdown- $else- <h4>Please ^{login} to post a comment.+ <div .avatar>+ <a target="_blank" title="change your profile picture at gravatar" href="http://gravatar.com/emails/">+ <img src="#{img email}"> - $if not $ null comments- <h4>Showing #{toHtml $ helper $ length comments}:+ <div .input>+ <form enctype="#{enctype}" method="post" .form-stacked>+ <div .clearfix .optional>+ <label for="username">Username+ <div .input>+ <p #username>#{username} - $forall comment <- comments- <div .yesod_comment>^{showCommentAuth comment}+ ^{form}++ <div .actions>+ <button .btn .primary type="submit">Add comment++ $else+ <h4>Please ^{login} to post a comment. |] -helper :: Int -> String-helper 0 = "no comments"-helper 1 = "1 comment"-helper n = show n ++ " comments"+ where+ img :: Text -> String+ img = gravatar def { gDefault = Just MM, gSize = Just $ Size 48 } --- | Show the authroute as a link if set up-login :: Yesod m => GWidget s m ()-login = do- lift $ setUltDest' -- so we come back here after login- mroute <- lift $ fmap authRoute getYesod- case mroute of- Just r -> [whamlet|<a href="@{r}">log in|]- Nothing -> [whamlet|log in|]+ login :: Yesod m => GWidget s m ()+ login = do+ mroute <- lift $ do+ setUltDestCurrent+ fmap authRoute getYesod++ case mroute of+ Just r -> [whamlet|<a href="@{r}">log in|]+ Nothing -> [whamlet|log in|]
Yesod/Comments/Core.hs view
@@ -4,7 +4,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Yesod.Comments.Core--- Copyright : (c) Patrick Brisbin 2010 +-- Copyright : (c) Patrick Brisbin 2010 -- License : as-is -- -- Maintainer : pbrisbin@gmail.com@@ -18,13 +18,13 @@ , CommentId , ThreadId , YesodComments (..)+ , Form , commentFromForm , commentForm , commentFormAuth- , commentFormEdit+ , commentLabel , handleForm- , handleFormEdit- , addStyling+ , showComments , showComment , showCommentAuth , getNextCommentId@@ -33,53 +33,44 @@ import Yesod import Yesod.Auth-import Yesod.Goodies.Gravatar-import Yesod.Goodies.Markdown-import Yesod.Goodies.Time-import Control.Applicative ((<$>), (<*>))+import Yesod.Markdown+import Control.Applicative ((<$>), (<*>), pure)+import Data.Text (Text) import Data.Time (UTCTime, getCurrentTime)+import Data.Time.Format.Human+import Network.Gravatar import Network.Wai (remoteHost)- import qualified Data.Text as T -type ThreadId = T.Text+type ThreadId = Text type CommentId = Int class Yesod m => YesodComments m where- -- | Find a specific comment- getComment :: ThreadId -> CommentId -> GHandler s m (Maybe Comment)-- -- | Store a new comment- storeComment :: Comment -> GHandler s m ()-- -- | Update a comment+ getComment :: ThreadId -> CommentId -> GHandler s m (Maybe Comment)+ storeComment :: Comment -> GHandler s m () updateComment :: Comment -> Comment -> GHandler s m ()-- -- | Remove a comment deleteComment :: Comment -> GHandler s m ()-- -- | Load all comments, possibly filtered to a single thread.- loadComments :: Maybe ThreadId -> GHandler s m [Comment]+ loadComments :: Maybe ThreadId -> GHandler s m [Comment] - -- | If using Auth, provide the function to get from a user id to - -- the string to use as the commenter's username. This should + -- | If using Auth, provide the function to get from a user id to+ -- the string to use as the commenter's username. This should -- return something friendly probably pulled from the user's -- profile on your site.- displayUser :: AuthId m -> GHandler s m T.Text- displayUser _ = return "" -- fixme: use toSinglePiece in new auth pkg+ displayUser :: AuthId m -> GHandler s m Text+ displayUser _ = return "" - -- | If using Auth, provide the function to get from a user id to + -- | If using Auth, provide the function to get from a user id to -- the string to use as the commenter's email.- displayEmail :: AuthId m -> GHandler s m T.Text+ displayEmail :: AuthId m -> GHandler s m Text displayEmail _ = return "" data Comment = Comment { threadId :: ThreadId , commentId :: CommentId , timeStamp :: UTCTime- , ipAddress :: T.Text- , userName :: T.Text- , userEmail :: T.Text+ , ipAddress :: Text+ , userName :: Text+ , userEmail :: Text , content :: Markdown , isAuth :: Bool }@@ -88,18 +79,20 @@ a == b = (threadId a == threadId b) && (commentId a == commentId b) data CommentForm = CommentForm- { formUser :: T.Text- , formEmail :: T.Text+ { formUser :: Text+ , formEmail :: Text , formComment :: Markdown , formIsAuth :: Bool } --- | Cleanse form input and create a 'Comment' to be stored+type Form s m x = Html -> MForm s m (FormResult x, GWidget s m ())+ commentFromForm :: YesodComments m => ThreadId -> CommentForm -> GHandler s m Comment commentFromForm tid cf = do now <- liftIO getCurrentTime- ip <- return . show . remoteHost =<< waiRequest+ ip <- fmap (show . remoteHost) waiRequest cid <- getNextCommentId tid+ return Comment { threadId = tid , commentId = cid @@ -111,155 +104,42 @@ , isAuth = formIsAuth cf } --- | The comment form itself-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}- ^{fieldRow fiComment}- <tr>- <td> - <td colspan="2">- <input type="submit" value="Add comment">- |])+commentForm :: RenderMessage m FormMessage => Form s m CommentForm+commentForm = renderBootstrap $ CommentForm+ <$> areq textField "Name" Nothing+ <*> areq emailField "Email" Nothing+ <*> areq markdownField commentLabel Nothing+ <*> pure False --- | The comment form if using authentication (uid is hidden and display--- name is shown) commentFormAuth :: RenderMessage m FormMessage- => T.Text -- ^ text version of uid- -> T.Text -- ^ friendly name- -> T.Text -- ^ email- -> 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 }+ => Text -- ^ Text version of uid+ -> Text -- ^ user's email+ -> Form s m CommentForm+commentFormAuth user email = renderBootstrap $ CommentForm+ <$> pure user <*> pure email+ <*> areq markdownField commentLabel Nothing+ <*> pure True - (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}"> - <table>- <tr>- <th>name:- <td colspan="2">#{username}+handleForm :: YesodComments m => FormResult CommentForm -> ThreadId -> GWidget s m ()+handleForm (FormSuccess cf) tid = lift $ do+ storeComment =<< commentFromForm tid cf+ setMessage "comment added."+ redirectCurrentRoute - ^{fieldRow fiComment}- <tr>- <td> - <td colspan="2">- <input type="submit" value="Add comment">- |])+handleForm _ _ = return () --- | The comment form used in the management edit page.-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>- <td> - <td colspan="2">- <input type="submit" value="Update comment">- |]) -fieldRow :: FieldView s m -> GWidget s m ()-fieldRow fv = [whamlet|- <tr .#{clazz fv}>- <th>- <label for="#{fvId fv}">#{fvLabel fv}- $maybe tt <- fvTooltip fv- <div .tooltip>#{tt}- <td>- ^{fvInput fv}- <td>- $maybe error <- fvErrors fv- #{error}- $nothing- - |]--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 ()-addStyling = addCassius [cassius|- .yesod_comment_input th- text-align: left- vertical-align: top- .yesod_comment_input textarea- height: 10ex- width: 50ex- .yesod_comment_avatar_input, .yesod_comment_avatar_list- float: left- .yesod_comment_avatar_input- margin-right: 5px- .yesod_comment_avatar_list- margin-right: 3px- |]---- | POST the form and insert the new comment-handleForm :: YesodComments m- => FormResult CommentForm- -> ThreadId- -> GWidget s m ()-handleForm res tid = case res of- FormMissing -> return ()- FormFailure _ -> return ()- FormSuccess cf -> lift $ do- storeComment =<< commentFromForm tid cf- setMessage "comment added."- redirectCurrentRoute---- | POST the form and update an existing comment-handleFormEdit :: YesodComments m- => Route m- -> FormResult CommentForm- -> Comment- -> GWidget s m ()-handleFormEdit r res comment = case res of- FormMissing -> return ()- FormFailure _ -> return ()- FormSuccess cf -> lift $ do- updateComment comment $ comment { content = formComment cf }- setMessage "comment updateded."- redirect RedirectTemporary r---- | Redirect back to the current route after a POST request-redirectCurrentRoute :: Yesod m => GHandler s m ()-redirectCurrentRoute = do- tm <- getRouteToMaster- mr <- getCurrentRoute- case mr of- Just r -> redirect RedirectTemporary $ tm r- Nothing -> notFound---- | Show a single comment-showComment :: Yesod m => Comment -> GWidget s m ()+showComment :: Comment -> GWidget s m () 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 :: (YesodAuth m, YesodComments m) => Comment -> GWidget s m () showCommentAuth comment = do let cusername = userName comment (cuname, cemail) <- if isAuth comment- then case fromSinglePiece $ cusername of+ then case fromPathPiece $ cusername of Just uid -> do uname <- lift $ displayUser uid email <- lift $ displayEmail uid@@ -269,27 +149,51 @@ showHelper comment (cuname, cemail) --- | Factor out common code-showHelper :: Yesod m => Comment -> (T.Text,T.Text) -> GWidget s m ()+showComments :: [Comment] -> (Comment -> GWidget s m ()) -> GWidget s m ()+showComments comments f = [whamlet|+ <div .list>+ $if not $ null comments+ <h4>Showing #{toHtml $ helper $ length comments}:++ $forall comment <- comments+ ^{f comment}+ |]++ where+ -- pluralize comments+ helper :: Int -> String+ helper 0 = "no comments"+ helper 1 = "1 comment"+ helper n = show n ++ " comments"++showHelper :: Comment -> (Text,Text) -> GWidget s m () showHelper comment (username, email) = do- commentTimestamp <- lift . humanReadableTime $ timeStamp comment+ commentTimestamp <- lift . liftIO . humanReadableTime $ timeStamp comment+ let anchor = "comment_" ++ show (commentId comment)- let img = gravatarImg email defaultOptions { gDefault = Just MM, gSize = Just $ Size 20 }- addHamlet [hamlet|- <div .yesod_comment_avatar_list>- <img src="#{img}"> - <p>- <a href="##{anchor}" id="#{anchor}">#{commentTimestamp}- , #{username} wrote:+ [whamlet|+ <div .comment>+ <div .attribution>+ <p>+ <span .avatar>+ <img src="#{img email}"> - <blockquote>- #{markdownToHtml $ content comment}+ <a href="##{anchor}" id="#{anchor}">#{commentTimestamp}+ , #{username} wrote:++ <div .content>+ <blockquote>+ #{markdownToHtml $ content comment} |] + where+ img :: Text -> String+ img = gravatar def { gDefault = Just MM, gSize = Just $ Size 20 }+ -- | As the final step before insert, this is called to get the next -- comment id for the thread. super-high concurrency is probably not--- well-supported here...+-- well-supported here. getNextCommentId :: YesodComments m => ThreadId -> GHandler s m CommentId getNextCommentId tid = go =<< loadComments (Just tid) @@ -298,13 +202,23 @@ go [] = return 1 go cs = return $ maximum (map commentId cs) + 1 --- | Note: this function does not requireAuthId so a non-logged in user--- just returns false.-isCommentingUser :: (YesodAuth m, YesodComments m)- => Comment- -> GHandler s m Bool+-- | Returns False when not logged in.+isCommentingUser :: YesodAuth m => Comment -> GHandler s m Bool isCommentingUser comment = do muid <- maybeAuthId- case muid of- Just uid -> return $ isAuth comment && toSinglePiece uid == userName comment- _ -> return False+ return $ case muid of+ Just uid -> isAuth comment && toPathPiece uid == userName comment+ _ -> False++-- | Redirect back to the current route after a POST request. Calls not+-- found if the current route is unknown.+redirectCurrentRoute :: Yesod m => GHandler s m ()+redirectCurrentRoute = do+ tm <- getRouteToMaster+ mr <- getCurrentRoute+ case mr of+ Just r -> redirect $ tm r+ Nothing -> notFound++commentLabel :: FieldSettings master+commentLabel = "Comment" { fsTooltip = Just "Comments are parsed as pandoc-style markdown." }
Yesod/Comments/Management.hs view
@@ -32,28 +32,29 @@ ------------------------------------------------------------------------------- module Yesod.Comments.Management ( CommentsAdmin- , CommentsAdminRoute(..) , getCommentsAdmin+ , Route(..) ) where import Yesod import Yesod.Auth import Yesod.Comments.Core-import Yesod.Goodies.Markdown+import Yesod.Markdown+import Control.Applicative ((<$>), (<*>), pure) import Control.Monad (forM, unless)-import Data.List (nub, sort)+import Data.List (sortBy, nub) import Data.Time (UTCTime, formatTime)-import System.Locale (defaultTimeLocale, rfc822DateFormat) import Language.Haskell.TH.Syntax hiding (lift)+import System.Locale (defaultTimeLocale, rfc822DateFormat) data CommentsAdmin = CommentsAdmin getCommentsAdmin :: a -> CommentsAdmin getCommentsAdmin = const CommentsAdmin -mkYesodSub "CommentsAdmin" +mkYesodSub "CommentsAdmin" [ ClassP ''YesodAuth [ VarT $ mkName "master" ]- , ClassP ''YesodComments [ VarT $ mkName "master" ] ] + , ClassP ''YesodComments [ VarT $ mkName "master" ] ] [parseRoutes| / OverviewR GET /view/#ThreadId/#CommentId ViewR GET@@ -67,10 +68,10 @@ threads <- getThreadedComments defaultLayout $ do setTitle "Comments administration"- addStyling+ [whamlet| <h1>Comments overview- <article .yesod_comments_overview>+ <div .yesod_comments .overview> $if null threads <p>No comments found. $else@@ -82,10 +83,10 @@ getViewR tid cid = withUserComment tid cid $ \comment -> defaultLayout $ do setTitle "View comment"- addStyling+ [whamlet| <h1>View comment- <article .yesod_comments_view_comment>+ <div .yesod_comments .view> <table> <tr> <th>Thread:@@ -120,14 +121,16 @@ defaultLayout $ do setTitle "Edit comment" handleFormEdit (tm OverviewR) res comment- addStyling [whamlet| <h1>Edit comment- <article .yesod_comments_edit_comment>+ <div .yesod_comments .edit> <h3>Update comment- <div .yesod_comment_input>- <form enctype="#{enctype}" method="post">^{form}- <p .helptext>Comments are parsed as pandoc-style markdown+ <div .input>+ <form enctype="#{enctype}" method="post" .form-stacked>+ ^{form}++ <div .actions>+ <button .btn .primary type="submit">Add comment |] postEditR :: (YesodAuth m, YesodComments m) => ThreadId -> CommentId -> GHandler CommentsAdmin m RepHtml@@ -138,7 +141,7 @@ tm <- getRouteToMaster deleteComment comment setMessage "comment deleted."- redirect RedirectTemporary $ tm OverviewR+ redirect $ tm OverviewR getThreadedComments :: (YesodAuth m, YesodComments m) => GHandler s m [(ThreadId, [Comment])] getThreadedComments = do@@ -147,12 +150,27 @@ mine <- isCommentingUser comment return $ if mine then [threadId comment] else [] - forM (sort . nub $ concat allThreads) $ \tid ->+ unsorted <- forM (nub $ concat allThreads) $ \tid -> return (tid, filter ((== tid) . threadId) allComments) + return . sortBy latest $ unsorted++latest :: (ThreadId, [Comment]) -> (ThreadId, [Comment]) -> Ordering+latest (t1, cs1) (t2,cs2) =+ -- note the comparason is reversed so that the more recent threads+ -- will sort first+ case compare (latest' cs1) (latest' cs2) of+ EQ -> compare t1 t2+ GT -> LT+ LT -> GT++ where+ latest' :: [Comment] -> UTCTime+ latest' = maximum . map timeStamp+ showThreadedComments :: (YesodAuth m, YesodComments m) => (ThreadId, [Comment]) -> GWidget CommentsAdmin m () showThreadedComments (tid, comments) = [whamlet|- <div .yesod_comments_overview_thread>+ <div .yesod_comments .thread> <h3>#{tid} $forall comment <- comments ^{showThreadComment comment}@@ -164,11 +182,11 @@ mine <- lift $ isCommentingUser comment [whamlet| $if mine- <div .yesod_comments_overview_comment_yours>+ <div .yours> ^{showCommentAuth comment} ^{updateLinks comment} $else- <div .yesod_comments_overview_comment>+ <div> ^{showCommentAuth comment} |] @@ -176,7 +194,7 @@ updateLinks (Comment tid cid _ _ _ _ _ _ )= do tm <- lift $ getRouteToMaster [whamlet|- <div .yesod_comments_update_links>+ <div .update_links> <p> <a href=@{tm $ ViewR tid cid}>View \ | @@ -186,7 +204,7 @@ |] -- | Find a comment by thread/id, ensure it's the logged in user's--- comment and execute and action on it. Gives notFound or+-- comment and execute an action on it. Gives notFound or -- permissionDenied in failing cases. withUserComment :: (YesodAuth m, YesodComments m) => ThreadId@@ -197,9 +215,23 @@ mcomment <- getComment tid cid case mcomment of Just comment -> do- _ <- requireAuthId+ _ <- requireAuthId mine <- isCommentingUser comment unless mine $ permissionDenied "you can only manage your own comments" f comment Nothing -> notFound++commentFormEdit :: RenderMessage m FormMessage => Comment -> Form s m CommentForm+commentFormEdit comment = renderBootstrap $ CommentForm+ <$> pure "" <*> pure ""+ <*> areq markdownField commentLabel (Just $ content comment)+ <*> pure True++handleFormEdit :: YesodComments m => Route m -> FormResult CommentForm -> Comment -> GWidget s m ()+handleFormEdit r (FormSuccess cf) comment = lift $ do+ updateComment comment $ comment { content = formComment cf }+ setMessage "comment updated."+ redirect r++handleFormEdit _ _ _ = return ()
Yesod/Comments/Storage.hs view
@@ -7,7 +7,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Yesod.Comments.Storage--- Copyright : (c) Patrick Brisbin 2010 +-- Copyright : (c) Patrick Brisbin 2010 -- License : as-is -- -- Maintainer : pbrisbin@gmail.com@@ -18,7 +18,7 @@ -- ------------------------------------------------------------------------------- module Yesod.Comments.Storage- ( + ( -- * Persist -- $persist getCommentPersist@@ -32,8 +32,9 @@ ) where import Yesod-import Yesod.Comments.Core (Comment(..), ThreadId, CommentId)-import Yesod.Goodies.Markdown (Markdown(..))+import Database.Persist.GenericSql (SqlPersist)+import Yesod.Comments.Core (Comment(..))+import Yesod.Markdown (Markdown(..)) import Data.Time.Clock (UTCTime) import qualified Data.Text as T @@ -88,27 +89,27 @@ , isAuth = sqlCommentIsAuth sqlComment } -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)+getCommentPersist :: (YesodPersistBackend m ~ SqlPersist, YesodPersist m) => T.Text -> Int -> GHandler s m (Maybe Comment)+getCommentPersist tid cid = return . fmap (fromSqlComment . entityVal) =<< runDB (getBy $ UniqueSqlComment tid cid) -storeCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> GHandler s m ()+storeCommentPersist :: (YesodPersist m, PersistStore (YesodPersistBackend m) (GHandler s m)) => Comment -> GHandler s m () storeCommentPersist c = return . const () =<< runDB (insert $ toSqlComment c) -- | Note, only updates the content record-updateCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> Comment -> GHandler s m ()+updateCommentPersist :: (YesodPersist m, PersistUnique (YesodPersistBackend m) (GHandler s m), PersistQuery (YesodPersistBackend m) (GHandler s m)) => 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 (Entity k _) -> runDB $ update k [SqlCommentContent =. newContent] _ -> return () -deleteCommentPersist :: (YesodPersist m, PersistBackend (YesodPersistBackend m) (GGHandler s m IO)) => Comment -> GHandler s m ()+deleteCommentPersist :: (YesodPersist m, PersistUnique (YesodPersistBackend m) (GHandler s m)) => 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 (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])+loadCommentsPersist :: (YesodPersistBackend m ~ SqlPersist, YesodPersist m) => Maybe T.Text -> GHandler s m [Comment]+loadCommentsPersist (Just tid) = return . fmap (fromSqlComment . entityVal) =<< runDB (selectList [SqlCommentThreadId ==. tid] [Asc SqlCommentCommentId])+loadCommentsPersist Nothing = return . fmap (fromSqlComment . entityVal) =<< runDB (selectList [] [Asc SqlCommentCommentId]) -- $todo --
yesod-comments.cabal view
@@ -1,5 +1,5 @@ name: yesod-comments-version: 0.5.0+version: 0.7 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@@ -19,15 +19,18 @@ , Yesod.Comments.Management -- Packages needed in order to build this package.- build-depends: base >= 4 && < 5- , text >= 0.11 && < 0.12- , bytestring >= 0.9.1 && < 0.10- , wai >= 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.6 && < 0.7+ build-depends: base >= 4 && < 5+ , text >= 0.11 && < 0.12+ , bytestring >= 0.9.1 && < 0.10+ , friendly-time >= 0.2 && < 0.3+ , gravatar >= 0.5 && < 0.6+ , persistent >= 0.9 && < 0.10+ , wai >= 1.2 && < 1.3+ , yesod >= 1.0 && < 1.1+ , yesod-auth >= 1.0 && < 1.1+ , yesod-form >= 1.0 && < 1.1+ , yesod-markdown >= 0.4 && < 0.5+ , template-haskell , directory , time