{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Articles.FeedArticles where

import Prelude hiding (get, on)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB (..), id2sqlKey, mapDBResult)
import Conduit.Features.Account.Common.FindFollowersByID (AquireFollowers, findFollowersByID)
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 (mkManyArticles)
import Conduit.Features.Articles.Errors (ArticleError)
import Conduit.Features.Articles.Types (ManyArticles(..))
import Conduit.Identity.Auth (authedUserID, withAuth)
import Conduit.Utils ((.-))
import Data.List (lookup)
import Database.Esqueleto.Experimental (groupBy, in_, limit, offset, orderBy, select, val, valList, where_, (:&)(..), (==.))
import Database.Esqueleto.Experimental qualified as E
import Relude.Extra (bimapBoth)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ActionT, ScottyT, captureParams, get, json)

data FilterOps = FilterOps
  { FilterOps -> Int64
filterLimit  :: Int64
  , FilterOps -> Int64
filterOffset :: Int64
  }

handleFeedArticles :: ScottyT AppM ()
handleFeedArticles :: ScottyT AppM ()
handleFeedArticles = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/articles/feed" (ActionT AppM () -> ScottyT AppM ())
-> ActionT AppM () -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ (AuthedUser -> ActionT AppM ()) -> ActionT AppM ()
forall (m :: * -> *) c.
(MonadIO m, MonadReader c m, Has JWTInfo c m) =>
(AuthedUser -> ActionT m ()) -> ActionT m ()
withAuth \AuthedUser
user -> do
  FilterOps
filterOps <- ActionT AppM FilterOps
parseFilterOps
  ManyArticles
articles <- AppM (Either ArticleError ManyArticles)
-> ActionT AppM ManyArticles
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService (AppM (Either ArticleError ManyArticles)
 -> ActionT AppM ManyArticles)
-> AppM (Either ArticleError ManyArticles)
-> ActionT AppM ManyArticles
forall a b. (a -> b) -> a -> b
$ UserID -> FilterOps -> AppM (Either ArticleError ManyArticles)
forall (m :: * -> *).
(AquireArticles m, AquireFollowers m) =>
UserID -> FilterOps -> m (Either ArticleError ManyArticles)
getFeedArticles AuthedUser
user.authedUserID FilterOps
filterOps
  ManyArticles -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json ManyArticles
articles

getFeedArticles :: (AquireArticles m, AquireFollowers m) => UserID -> FilterOps -> m (Either ArticleError ManyArticles)
getFeedArticles :: forall (m :: * -> *).
(AquireArticles m, AquireFollowers m) =>
UserID -> FilterOps -> m (Either ArticleError ManyArticles)
getFeedArticles UserID
userID FilterOps
ops = ExceptT ArticleError m ManyArticles
-> m (Either ArticleError ManyArticles)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  [UserID]
followers <- m (Either ArticleError [UserID]) -> ExceptT ArticleError m [UserID]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError [UserID])
 -> ExceptT ArticleError m [UserID])
-> m (Either ArticleError [UserID])
-> ExceptT ArticleError m [UserID]
forall a b. (a -> b) -> a -> b
$ UserID -> m (Either ArticleError [UserID])
forall e (m :: * -> *).
(FeatureErrorMapper AccountError e, AquireFollowers m) =>
UserID -> m (Either e [UserID])
findFollowersByID UserID
userID
  m (Either ArticleError ManyArticles)
-> ExceptT ArticleError m ManyArticles
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ArticleError ManyArticles)
 -> ExceptT ArticleError m ManyArticles)
-> m (Either ArticleError ManyArticles)
-> ExceptT ArticleError m ManyArticles
forall a b. (a -> b) -> a -> b
$ UserID
-> [UserID] -> FilterOps -> m (Either ArticleError ManyArticles)
forall (m :: * -> *).
AquireArticles m =>
UserID
-> [UserID] -> FilterOps -> m (Either ArticleError ManyArticles)
findArticles UserID
userID [UserID]
followers FilterOps
ops

parseFilterOps :: ActionT AppM FilterOps
parseFilterOps :: ActionT AppM FilterOps
parseFilterOps = do
  [(Text, Text)]
params <- ActionT AppM [Param]
forall (m :: * -> *). Monad m => ActionT m [Param]
captureParams ActionT AppM [Param]
-> ([Param] -> [(Text, Text)]) -> ActionT AppM [(Text, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Param -> (Text, Text)) -> [Param] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> Param -> (Text, Text)
forall (f :: * -> * -> *) a b.
Bifunctor f =>
(a -> b) -> f a a -> f b b
bimapBoth Text -> Text
forall l s. LazyStrict l s => l -> s
toStrict)

  FilterOps -> ActionT AppM FilterOps
forall a. a -> ActionT AppM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilterOps -> ActionT AppM FilterOps)
-> FilterOps -> ActionT AppM FilterOps
forall a b. (a -> b) -> a -> b
$ FilterOps
    { $sel:filterLimit:FilterOps :: Int64
filterLimit  = (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"limit"  [(Text, Text)]
params Maybe Text -> (Text -> Maybe Int64) -> Maybe Int64
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (String -> Maybe Int64) -> Text -> Maybe Int64
forall a b c. (a -> b) -> (b -> c) -> a -> c
.- String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe) Maybe Int64 -> Int64 -> Int64
forall a. Maybe a -> a -> a
?: Int64
20
    , $sel:filterOffset:FilterOps :: Int64
filterOffset = (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"offset" [(Text, Text)]
params Maybe Text -> (Text -> Maybe Int64) -> Maybe Int64
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (String -> Maybe Int64) -> Text -> Maybe Int64
forall a b c. (a -> b) -> (b -> c) -> a -> c
.- String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe) Maybe Int64 -> Int64 -> Int64
forall a. Maybe a -> a -> a
?: Int64
0
    }

class (Monad m) => AquireArticles m where
  findArticles :: UserID -> [UserID] -> FilterOps -> m (Either ArticleError ManyArticles)

instance (Monad m, MonadDB m, MonadUnliftIO m) => AquireArticles m where
  findArticles :: UserID -> [UserID] -> FilterOps -> m (Either ArticleError ManyArticles)
  findArticles :: UserID
-> [UserID] -> FilterOps -> m (Either ArticleError ManyArticles)
findArticles UserID
userID ((UserID -> UserId) -> [UserID] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map UserID -> UserId
forall t id. SqlKey t id => id -> Key t
id2sqlKey -> [UserId]
followeeIDs) FilterOps {Int64
$sel:filterLimit:FilterOps :: FilterOps -> Int64
$sel:filterOffset:FilterOps :: FilterOps -> Int64
filterLimit :: Int64
filterOffset :: Int64
..} = ([(Entity Article, Entity User, Value Bool, Value Bool, Value Int)]
 -> ManyArticles)
-> Either
     DBError
     [(Entity Article, Entity User, Value Bool, Value Bool, Value Int)]
-> Either ArticleError ManyArticles
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
mapDBResult [(Entity Article, Entity User, Value Bool, Value Bool, Value Int)]
-> ManyArticles
mkManyArticles (Either
   DBError
   [(Entity Article, Entity User, Value Bool, Value Bool, Value Int)]
 -> Either ArticleError ManyArticles)
-> m (Either
        DBError
        [(Entity Article, Entity User, Value Bool, Value Bool, Value Int)])
-> m (Either ArticleError ManyArticles)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT
  m
  [(Entity Article, Entity User, Value Bool, Value Bool, Value Int)]
-> m (Either
        DBError
        [(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
     [(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 [r]
select (SqlQuery
   (SqlExpr (Entity Article), SqlExpr (Entity User),
    SqlExpr (Value Bool), SqlExpr (Value Bool), SqlExpr (Value Int))
 -> SqlPersistT
      m
      [(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
     [(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)
_) <- 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
forall a. Maybe a
Nothing ((SqlExpr (Entity Article)
  -> SqlExpr (Entity User) -> SqlExpr (Value Bool))
 -> SqlQuery
      (SqlExpr (Entity Article) :& SqlExpr (Entity User),
       SqlExpr (Value Bool)))
-> (SqlExpr (Entity Article)
    -> SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery
     (SqlExpr (Entity Article) :& SqlExpr (Entity User),
      SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ \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 UserId), SqlExpr (Value (Key Article)))
-> SqlQuery ()
forall a. ToSomeValues a => a -> SqlQuery ()
groupBy (SqlExpr (Entity User)
u.id, SqlExpr (Entity Article)
a.id)

      SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity User)
u.id SqlExpr (Value UserId)
-> SqlExpr (ValueList UserId) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`in_` [UserId] -> SqlExpr (ValueList UserId)
forall typ. PersistField typ => [typ] -> SqlExpr (ValueList typ)
valList [UserId]
followeeIDs

      Int64 -> SqlQuery ()
limit  Int64
filterLimit
      Int64 -> SqlQuery ()
offset Int64
filterOffset

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

      [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr (Value UTCTime) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.desc SqlExpr (Entity Article)
a.created]

      (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, Bool -> SqlExpr (Value Bool)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True, SqlExpr (Value Bool)
favorited, SqlExpr (Value Int)
numFavs)