finished getCommentsSlugCoach.

parent 53123fa7
......@@ -27,6 +27,7 @@ library
, Que.Tags
, Que.Users
, Que.Articles
, Que.Comments
, Coach.Tags
, Coach.Users
, Coach.Profile
......
......@@ -74,6 +74,7 @@ articlesApi authres =
:<|> postArticleCreateCoach authres
:<|> deleteArticleSlugCoach authres
:<|> putArticleSlugCoach authres
:<|> getCommentsSlugCoach authres
:<|> panic ""
articlesServer :: Configuration -> AuthResult User -> Server ArticlesAPI
......
......@@ -16,6 +16,7 @@ import Types
import Util
import Que.Articles
import Que.Comments
getArticlesCoach ::
MonadIO m
......@@ -88,33 +89,6 @@ getArticlesFeed (Authenticated User {..}) mlimit moffset = do
(length articles)
getArticlesFeed _ _ _ = throwError err401 {errBody = "Only authenticated user."}
resultQueryToResponseArticle ::
( Entity Article
, Entity User
, Value (Maybe [Text])
, Value Int64
, Value Bool
, Value Bool)
-> ResponseArticleBody
resultQueryToResponseArticle (entarticle, entauthor, vtags, vfavcounts, vfaving, vfoll) =
let Article {..} = entityVal entarticle
User {..} = entityVal entauthor
tagnames = unValue vtags
favcounts = unValue vfavcounts
isfavoriting = unValue vfaving
isfollowing = unValue vfoll
in ResponseArticleBody
articleSlug
articleTitle
articleDescription
articleBody
tagnames
articleCreatedAt
articleUpdatedAt
isfavoriting
favcounts $
ResponseProfileBody userUsername userBio userImage isfollowing
postArticleCreateCoach ::
MonadIO m
=> AuthResult User
......@@ -196,3 +170,59 @@ reqUpdateIsEmpty RequestUpdateArticleBody {..} =
isNothing requpdtarticbodyBody
&& isNothing requpdtarticbodyDescription
&& isNothing requpdtarticbodyTitle
getCommentsSlugCoach ::
MonadIO m => AuthResult User -> Text -> CoachT m ResponseMultiComment
getCommentsSlugCoach authres slug = do
marticle <- runDb $ getBy $ UniqueSlug slug
when (isNothing marticle) $
throwError err404 {errBody = "There's no such thing."}
comments <-
runDb $ selectComments (userUsername <$> authresToMaybe authres) slug
return $ ResponseMultiComment $ map resultQueryToResponseComment comments
postCommentSlugCoach :: MonadIO m => AuthResult User -> Text -> RequestComment -> CoachT m ResponseComment
postCommentSlugCoach (Authenticated User {..}) slug reqcomment = do
marticle <- runDb $ getBy $ UniqueSlug slug
when (isNothing marticle) $
throwError err404 {errBody = "There's no such thing."}
panic ""
postCommentSlugCoach _ _ _ = throwError err401
resultQueryToResponseComment ::
(Entity Comment, Entity User, Value Bool) -> ResponseCommentBody
resultQueryToResponseComment ((Entity cid Comment {..}), (Entity _ User {..}), (Value isfollowing)) =
let commid = fromSqlKey cid
in ResponseCommentBody
commid
commentCreatedAt
commentUpdatedAt
commentBody
(ResponseProfileBody userUsername userBio userImage isfollowing)
resultQueryToResponseArticle ::
( Entity Article
, Entity User
, Value (Maybe [Text])
, Value Int64
, Value Bool
, Value Bool)
-> ResponseArticleBody
resultQueryToResponseArticle (entarticle, entauthor, vtags, vfavcounts, vfaving, vfoll) =
let Article {..} = entityVal entarticle
User {..} = entityVal entauthor
tagnames = unValue vtags
favcounts = unValue vfavcounts
isfavoriting = unValue vfaving
isfollowing = unValue vfoll
in ResponseArticleBody
articleSlug
articleTitle
articleDescription
articleBody
tagnames
articleCreatedAt
articleUpdatedAt
isfavoriting
favcounts $
ResponseProfileBody userUsername userBio userImage isfollowing
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Que.Comments where
import Lib.Prelude hiding (from, get, on, (<&>))
import Database.Esqueleto
import Model
selectComments ::
( PersistUniqueRead backend
, PersistQueryRead backend
, BackendCompatible SqlBackend backend
, MonadIO m
)
=> Maybe Text
-> Text
-> ReaderT backend m [(Entity Comment, Entity User, Value Bool)]
selectComments musername slug = do
select $
from $ \(article `InnerJoin` comment `InnerJoin` commentator) -> do
on $ comment ^. CommentUserId ==. commentator ^. UserId
on $ article ^. ArticleId ==. comment ^. CommentArticleId
let following Nothing = val False
following (Just x) =
case_
[ when_
(exists $
from $ \(user, follow) -> do
where_ $ user ^. UserId ==. follow ^. FollowFollowerId
where_ $ commentator ^. UserId ==. follow ^. FollowAuthorId
where_ $ user ^. UserUsername ==. val x)
then_ $
val True
]
(else_ $ val False)
where_ $ article ^. ArticleSlug ==. val slug
orderBy [asc (comment ^. CommentId)]
return (comment, commentator, following musername)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment