{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Comments.GetComments where

import Prelude hiding (get)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), mapDBResult, sqlKey2ID)
import Conduit.Features.Account.DB (User, mkProfile)
import Conduit.Features.Account.Common.QueryAssociatedUser (queryAssociatedUser)
import Conduit.Features.Account.Types (UserID(..))
import Conduit.Features.Articles.DB (Comment(..))
import Conduit.Features.Articles.Errors (ArticleError)
import Conduit.Features.Articles.Slugs (extractIDFromSlug)
import Conduit.Features.Articles.Types (ArticleID(..), ManyComments(..), OneComment(..), Slug(..))
import Conduit.Identity.Auth (authedUserID, maybeWithAuth)
import Database.Esqueleto.Experimental (Entity(..), Value, select, valkey, where_, (:&)(..), (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, get, json)

handleGetComments :: ScottyT AppM ()
handleGetComments :: ScottyT AppM ()
handleGetComments = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/articles/:slug/comments" (ActionT AppM () -> ScottyT AppM ())
-> ActionT AppM () -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ (Maybe AuthedUser -> ActionT AppM ()) -> ActionT AppM ()
forall (m :: * -> *) c.
(MonadIO m, Has JWTInfo c m) =>
(Maybe AuthedUser -> ActionT m ()) -> ActionT m ()
maybeWithAuth \Maybe AuthedUser
user -> do
  Slug
slug <- Text -> ActionT AppM Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
captureParam Text
"slug" ActionT AppM Text -> (Text -> Slug) -> ActionT AppM Slug
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Slug
Slug
  ManyComments
comment <- AppM (Either ArticleError ManyComments)
-> ActionT AppM ManyComments
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError ManyComments)
 -> ActionT AppM ManyComments)
-> AppM (Either ArticleError ManyComments)
-> ActionT AppM ManyComments
forall a b. (a -> b) -> a -> b
$ Slug -> Maybe UserID -> AppM (Either ArticleError ManyComments)
forall (m :: * -> *).
AquireComment m =>
Slug -> Maybe UserID -> m (Either ArticleError ManyComments)
getComments Slug
slug (Maybe AuthedUser
user Maybe AuthedUser -> (AuthedUser -> UserID) -> Maybe UserID
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> AuthedUser -> UserID
authedUserID)
  ManyComments -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json ManyComments
comment

getComments :: (AquireComment m) => Slug -> Maybe UserID -> m (Either ArticleError ManyComments)
getComments :: forall (m :: * -> *).
AquireComment m =>
Slug -> Maybe UserID -> m (Either ArticleError ManyComments)
getComments Slug
slug Maybe UserID
userID = ExceptT ArticleError m ManyComments
-> m (Either ArticleError ManyComments)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  ArticleID
articleID <- m (Either ArticleError ArticleID)
-> ExceptT ArticleError m ArticleID
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ArticleID)
 -> ExceptT ArticleError m ArticleID)
-> (Either ArticleError ArticleID
    -> m (Either ArticleError ArticleID))
-> Either ArticleError ArticleID
-> ExceptT ArticleError m ArticleID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ArticleError ArticleID -> m (Either ArticleError ArticleID)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ArticleError ArticleID -> ExceptT ArticleError m ArticleID)
-> Either ArticleError ArticleID
-> ExceptT ArticleError m ArticleID
forall a b. (a -> b) -> a -> b
$ Slug -> Either ArticleError ArticleID
extractIDFromSlug Slug
slug
  m (Either ArticleError ManyComments)
-> ExceptT ArticleError m ManyComments
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ManyComments)
 -> ExceptT ArticleError m ManyComments)
-> m (Either ArticleError ManyComments)
-> ExceptT ArticleError m ManyComments
forall a b. (a -> b) -> a -> b
$ ArticleID -> Maybe UserID -> m (Either ArticleError ManyComments)
forall (m :: * -> *).
AquireComment m =>
ArticleID -> Maybe UserID -> m (Either ArticleError ManyComments)
findCommentsForArticle ArticleID
articleID Maybe UserID
userID

class (Monad m) => AquireComment m where
  findCommentsForArticle :: ArticleID -> Maybe UserID -> m (Either ArticleError ManyComments)

instance (Monad m, MonadDB m, MonadUnliftIO m) => AquireComment m where
  findCommentsForArticle :: ArticleID -> Maybe UserID -> m (Either ArticleError ManyComments)
  findCommentsForArticle :: ArticleID -> Maybe UserID -> m (Either ArticleError ManyComments)
findCommentsForArticle ArticleID
articleID Maybe UserID
userID = ([(Entity Comment, Entity User, Value Bool)] -> ManyComments)
-> Either DBError [(Entity Comment, Entity User, Value Bool)]
-> Either ArticleError ManyComments
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
mapDBResult [(Entity Comment, Entity User, Value Bool)] -> ManyComments
toManyComments (Either DBError [(Entity Comment, Entity User, Value Bool)]
 -> Either ArticleError ManyComments)
-> m (Either DBError [(Entity Comment, Entity User, Value Bool)])
-> m (Either ArticleError ManyComments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m [(Entity Comment, Entity User, Value Bool)]
-> m (Either DBError [(Entity Comment, Entity User, Value Bool)])
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    SqlQuery
  (SqlExpr (Entity Comment), SqlExpr (Entity User),
   SqlExpr (Value Bool))
-> SqlPersistT m [(Entity Comment, Entity User, Value Bool)]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery
   (SqlExpr (Entity Comment), SqlExpr (Entity User),
    SqlExpr (Value Bool))
 -> SqlPersistT m [(Entity Comment, Entity User, Value Bool)])
-> SqlQuery
     (SqlExpr (Entity Comment), SqlExpr (Entity User),
      SqlExpr (Value Bool))
-> SqlPersistT m [(Entity Comment, Entity User, Value Bool)]
forall a b. (a -> b) -> a -> b
$ do
      (SqlExpr (Entity Comment)
c :& SqlExpr (Entity User)
u, SqlExpr (Value Bool)
follows) <- Maybe UserID
-> (SqlExpr (Entity Comment)
    -> SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery
     (SqlExpr (Entity Comment) :& SqlExpr (Entity User),
      SqlExpr (Value Bool))
forall table.
PersistEntity table =>
Maybe UserID
-> (SqlExpr (Entity table)
    -> SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery
     (SqlExpr (Entity table) :& SqlExpr (Entity User),
      SqlExpr (Value Bool))
queryAssociatedUser Maybe UserID
userID \SqlExpr (Entity Comment)
c SqlExpr (Entity User)
u ->
        SqlExpr (Entity Comment)
c.author SqlExpr (Value UserId)
-> SqlExpr (Value UserId) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity User)
u.id

      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity Comment)
c.article SqlExpr (Value (Key Article))
-> SqlExpr (Value (Key Article)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Int64 -> SqlExpr (Value (Key Article))
forall entity.
(ToBackendKey SqlBackend entity, PersistField (Key entity)) =>
Int64 -> SqlExpr (Value (Key entity))
valkey ArticleID
articleID.unID

      (SqlExpr (Entity Comment), SqlExpr (Entity User),
 SqlExpr (Value Bool))
-> SqlQuery
     (SqlExpr (Entity Comment), SqlExpr (Entity User),
      SqlExpr (Value Bool))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Comment)
c, SqlExpr (Entity User)
u, SqlExpr (Value Bool)
follows)

toManyComments :: [(Entity Comment, Entity User, Value Bool)] -> ManyComments
toManyComments :: [(Entity Comment, Entity User, Value Bool)] -> ManyComments
toManyComments = [OneComment] -> ManyComments
ManyComments ([OneComment] -> ManyComments)
-> ([(Entity Comment, Entity User, Value Bool)] -> [OneComment])
-> [(Entity Comment, Entity User, Value Bool)]
-> ManyComments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity Comment, Entity User, Value Bool) -> OneComment)
-> [(Entity Comment, Entity User, Value Bool)] -> [OneComment]
forall a b. (a -> b) -> [a] -> [b]
map (Entity Comment, Entity User, Value Bool) -> OneComment
toOneComment

toOneComment :: (Entity Comment, Entity User, Value Bool) -> OneComment
toOneComment :: (Entity Comment, Entity User, Value Bool) -> OneComment
toOneComment (Entity Key Comment
commentID Comment
comment, Entity User
user, Value Bool
follows) = OneComment
  { $sel:commentID:OneComment :: CommentID
commentID = Key Comment
commentID Key Comment -> (Key Comment -> CommentID) -> CommentID
forall a b. a -> (a -> b) -> b
& Key Comment -> CommentID
forall t id. SqlKey t id => Key t -> id
sqlKey2ID
  , $sel:body:OneComment :: Text
body = Comment
comment.commentBody
  , $sel:created:OneComment :: UTCTime
created = Comment
comment.commentCreated
  , $sel:updated:OneComment :: UTCTime
updated = Comment
comment.commentUpdated
  , $sel:author:OneComment :: UserProfile
author = Entity User -> Value Bool -> UserProfile
mkProfile Entity User
user Value Bool
follows
  }