{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Articles.GetArticle where

import Prelude hiding (get, on)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB (..), id2sqlKey, mapMaybeDBResult)
import Conduit.Features.Account.Common.FindProfileByID (AcquireProfile)
import Conduit.Features.Account.Common.QueryAssociatedUser (queryAssociatedUser)
import Conduit.Features.Account.Types (UserID)
import Conduit.Features.Articles.Common.QueryFavStats (queryFavStats)
import Conduit.Features.Articles.DB (mkOneArticle)
import Conduit.Features.Articles.Errors (ArticleError(..))
import Conduit.Features.Articles.Slugs (extractIDFromSlug)
import Conduit.Features.Articles.Types (ArticleID, OneArticle(..), Slug(..), inArticleObj)
import Conduit.Identity.Auth (AuthedUser(..), maybeWithAuth)
import Database.Esqueleto.Experimental (selectOne, val, where_, (:&)(..), (==.))
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, captureParam, get, json)

handleGetArticle :: ScottyT AppM ()
handleGetArticle :: ScottyT AppM ()
handleGetArticle = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/articles/:slug" (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
  OneArticle
article <- AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle)
-> AppM (Either ArticleError OneArticle) -> ActionT AppM OneArticle
forall a b. (a -> b) -> a -> b
$ Slug -> Maybe UserID -> AppM (Either ArticleError OneArticle)
forall (m :: * -> *).
(AquireArticle m, AcquireProfile m) =>
Slug -> Maybe UserID -> m (Either ArticleError OneArticle)
getArticle 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)
  InObj OneArticle -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj OneArticle -> ActionT AppM ())
-> InObj OneArticle -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ OneArticle -> InObj OneArticle
forall obj. obj -> InObj obj
inArticleObj OneArticle
article

getArticle :: (AquireArticle m, AcquireProfile m) => Slug -> Maybe UserID -> m (Either ArticleError OneArticle)
getArticle :: forall (m :: * -> *).
(AquireArticle m, AcquireProfile m) =>
Slug -> Maybe UserID -> m (Either ArticleError OneArticle)
getArticle Slug
slug Maybe UserID
userID = ExceptT ArticleError m OneArticle
-> m (Either ArticleError OneArticle)
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 OneArticle)
-> ExceptT ArticleError m OneArticle
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError OneArticle)
 -> ExceptT ArticleError m OneArticle)
-> m (Either ArticleError OneArticle)
-> ExceptT ArticleError m OneArticle
forall a b. (a -> b) -> a -> b
$ ArticleID -> Maybe UserID -> m (Either ArticleError OneArticle)
forall (m :: * -> *).
AquireArticle m =>
ArticleID -> Maybe UserID -> m (Either ArticleError OneArticle)
findArticleByID ArticleID
articleID Maybe UserID
userID

class (Monad m) => AquireArticle m where
  findArticleByID :: ArticleID -> Maybe UserID -> m (Either ArticleError OneArticle)

instance (Monad m, MonadDB m, MonadUnliftIO m) => AquireArticle m where
  findArticleByID :: ArticleID -> Maybe UserID -> m (Either ArticleError OneArticle)
  findArticleByID :: ArticleID -> Maybe UserID -> m (Either ArticleError OneArticle)
findArticleByID ArticleID
articleID Maybe UserID
userID = ArticleError
-> ((Entity Article, Entity User, Value Bool, Value Bool,
     Value Int)
    -> OneArticle)
-> Either
     DBError
     (Maybe
        (Entity Article, Entity User, Value Bool, Value Bool, Value Int))
-> Either ArticleError OneArticle
forall e a b.
FeatureError e =>
e -> (a -> b) -> Either DBError (Maybe a) -> Either e b
mapMaybeDBResult ArticleError
ResourceNotFoundEx (Entity Article, Entity User, Value Bool, Value Bool, Value Int)
-> OneArticle
mkOneArticle (Either
   DBError
   (Maybe
      (Entity Article, Entity User, Value Bool, Value Bool, Value Int))
 -> Either ArticleError OneArticle)
-> m (Either
        DBError
        (Maybe
           (Entity Article, Entity User, Value Bool, Value Bool, Value Int)))
-> m (Either ArticleError OneArticle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT
  m
  (Maybe
     (Entity Article, Entity User, Value Bool, Value Bool, Value Int))
-> m (Either
        DBError
        (Maybe
           (Entity Article, Entity User, Value Bool, Value Bool, Value Int)))
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 Article), SqlExpr (Entity User),
   SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
-> SqlPersistT
     m
     (Maybe
        (Entity Article, Entity User, Value Bool, Value Bool, Value Int))
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m (Maybe r)
selectOne (SqlQuery
   (SqlExpr (Entity Article), SqlExpr (Entity User),
    SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
 -> SqlPersistT
      m
      (Maybe
         (Entity Article, Entity User, Value Bool, Value Bool, Value Int)))
-> SqlQuery
     (SqlExpr (Entity Article), SqlExpr (Entity User),
      SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
-> SqlPersistT
     m
     (Maybe
        (Entity Article, Entity User, Value Bool, Value Bool, Value Int))
forall a b. (a -> b) -> a -> b
$ do
      (SqlExpr (Entity Article)
a :& SqlExpr (Entity User)
u, SqlExpr (Value Bool)
follows) <- Maybe UserID
-> (SqlExpr (Entity Article)
    -> SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery
     (SqlExpr (Entity Article) :& 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 Article)
a SqlExpr (Entity User)
u ->
        SqlExpr (Entity Article)
a.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 (Entity Article)
a.id SqlExpr (Value (Key Article))
-> SqlExpr (Value (Key Article)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Key Article -> SqlExpr (Value (Key Article))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val (ArticleID -> Key Article
forall t id. SqlKey t id => id -> Key t
id2sqlKey ArticleID
articleID))

      let (SqlExpr (Value Bool)
favorited, SqlExpr (Value Int)
numFavs) = Maybe UserID
-> SqlExpr (Entity Article)
-> (SqlExpr (Value Bool), SqlExpr (Value Int))
queryFavStats Maybe UserID
userID SqlExpr (Entity Article)
a

      (SqlExpr (Entity Article), SqlExpr (Entity User),
 SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
-> SqlQuery
     (SqlExpr (Entity Article), SqlExpr (Entity User),
      SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity Article)
a, SqlExpr (Entity User)
u, SqlExpr (Value Bool)
follows, SqlExpr (Value Bool)
favorited, SqlExpr (Value Int)
numFavs)