{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------- -- | -- Module : Yesod.Comments.Core -- Copyright : (c) Patrick Brisbin 2010 -- License : as-is -- -- Maintainer : pbrisbin@gmail.com -- Stability : unstable -- Portability : unportable -- ------------------------------------------------------------------------------- module Yesod.Comments.Core ( Comment(..) , CommentForm(..) , CommentId , ThreadId , YesodComments (..) , commentFromForm , commentForm , commentFormAuth , showComment , showCommentAuth ) where import Yesod import Yesod.Form.Core import Yesod.Helpers.Auth import Yesod.Goodies.Gravatar import Yesod.Goodies.Markdown import Yesod.Goodies.Time import Control.Applicative ((<$>), (<*>)) import Data.Time (UTCTime, getCurrentTime) import Network.Wai (remoteHost) import qualified Data.Text as T type ThreadId = T.Text type CommentId = Int class Yesod m => YesodComments m where -- Data base actions getComment :: ThreadId -> CommentId -> GHandler s m (Maybe Comment) storeComment :: Comment -> GHandler s m () deleteComment :: Comment -> GHandler s m () -- | Loading all comments, possibly filtered to a single thread. loadComments :: Maybe ThreadId -> GHandler s m [Comment] -- | Get the next available Id given the passed list of comments. In -- Handler in case there is a database call involved. getNextCommentId :: [Comment] -> GHandler s m CommentId getNextCommentId [] = return 1 getNextCommentId cs = return $ maximum (map commentId cs) + 1 -- | See "Yesod.Comments.Filters" commentFilters :: [(Comment -> GHandler s m Bool)] commentFilters = [] -- | 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 friendlier than just a conversion to 'String' displayUser :: AuthId m -> GHandler s m T.Text displayUser _ = return "" -- | if using Auth, provide the function to get form a user id to -- the string to use as the commenter's email. displayEmail :: AuthId m -> GHandler s m T.Text displayEmail _ = return "" data Comment = Comment { threadId :: ThreadId , commentId :: CommentId , timeStamp :: UTCTime , ipAddress :: T.Text , userName :: T.Text , userEmail :: T.Text , content :: Markdown } data CommentForm = CommentForm { formUser :: T.Text , formEmail :: T.Text , formComment :: Markdown } -- | Cleanse form input and create a 'Comment' to be stored commentFromForm :: ThreadId -> CommentId -> CommentForm -> GHandler s m Comment commentFromForm tid cid cf = do now <- liftIO getCurrentTime ip <- return . show . remoteHost =<< waiRequest return Comment { threadId = tid , commentId = cid , timeStamp = now , ipAddress = T.pack ip , userName = formUser cf , userEmail = formEmail cf , content = formComment cf } -- | 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, [hamlet|
|]) -- | 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 return (CommentForm <$> user <*> email' <*> comment, [hamlet| |