{-# LANGUAGE UndecidableInstances #-} module Conduit.Features.Account.Common.FindProfileByID where import Prelude hiding (get, on) import Conduit.DB.Core (MonadDB(..), mapMaybeDBResult) import Conduit.DB.Utils (suchThat) import Conduit.Errors (FeatureErrorMapper(..)) import Conduit.Features.Account.Common.QueryUserFollows (queryIfUserFollows) import Conduit.Features.Account.DB (mkProfile) import Conduit.Features.Account.Errors (AccountError(..)) import Conduit.Features.Account.Types (UserID(..), UserProfile(..)) import Database.Esqueleto.Experimental (from, selectOne, table, valkey, (==.)) import UnliftIO (MonadUnliftIO) findUserProfileByID :: (FeatureErrorMapper AccountError e, AcquireProfile m) => UserID -> Maybe UserID -> m (Either e UserProfile) findUserProfileByID :: forall e (m :: * -> *). (FeatureErrorMapper AccountError e, AcquireProfile m) => UserID -> Maybe UserID -> m (Either e UserProfile) findUserProfileByID UserID user Maybe UserID currUser = (AccountError -> e) -> Either AccountError UserProfile -> Either e UserProfile forall a b c. (a -> b) -> Either a c -> Either b c forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first AccountError -> e forall e1 e2. FeatureErrorMapper e1 e2 => e1 -> e2 mapFeatureError (Either AccountError UserProfile -> Either e UserProfile) -> m (Either AccountError UserProfile) -> m (Either e UserProfile) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> UserID -> Maybe UserID -> m (Either AccountError UserProfile) forall (m :: * -> *). AcquireProfile m => UserID -> Maybe UserID -> m (Either AccountError UserProfile) findUserByID UserID user Maybe UserID currUser class (Monad m) => AcquireProfile m where findUserByID :: UserID -> Maybe UserID -> m (Either AccountError UserProfile) instance (Monad m, MonadUnliftIO m, MonadDB m) => AcquireProfile m where findUserByID :: UserID -> Maybe UserID -> m (Either AccountError UserProfile) findUserByID :: UserID -> Maybe UserID -> m (Either AccountError UserProfile) findUserByID UserID user Maybe UserID currUserID = AccountError -> ((Entity User, Value Bool) -> UserProfile) -> Either DBError (Maybe (Entity User, Value Bool)) -> Either AccountError UserProfile forall e a b. FeatureError e => e -> (a -> b) -> Either DBError (Maybe a) -> Either e b mapMaybeDBResult AccountError UserNotFoundEx ((Entity User -> Value Bool -> UserProfile) -> (Entity User, Value Bool) -> UserProfile forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Entity User -> Value Bool -> UserProfile mkProfile) (Either DBError (Maybe (Entity User, Value Bool)) -> Either AccountError UserProfile) -> m (Either DBError (Maybe (Entity User, Value Bool))) -> m (Either AccountError UserProfile) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> SqlPersistT m (Maybe (Entity User, Value Bool)) -> m (Either DBError (Maybe (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 User), SqlExpr (Value Bool)) -> SqlPersistT m (Maybe (Entity User, Value Bool)) forall a r (m :: * -> *) backend. (SqlSelect a r, MonadIO m, SqlBackendCanRead backend) => SqlQuery a -> ReaderT backend m (Maybe r) selectOne (SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool)) -> SqlPersistT m (Maybe (Entity User, Value Bool))) -> SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool)) -> SqlPersistT m (Maybe (Entity User, Value Bool)) forall a b. (a -> b) -> a -> b $ do SqlExpr (Entity User) u <- From (SqlExpr (Entity User)) -> SqlQuery (SqlExpr (Entity User)) forall a a'. ToFrom a a' => a -> SqlQuery a' from From (SqlExpr (Entity User)) forall ent. PersistEntity ent => From (SqlExpr (Entity ent)) table SqlQuery (SqlExpr (Entity User)) -> (SqlExpr (Entity User) -> SqlExpr (Value Bool)) -> SqlQuery (SqlExpr (Entity User)) forall a. SqlQuery a -> (a -> SqlExpr (Value Bool)) -> SqlQuery a `suchThat` \SqlExpr (Entity User) u -> SqlExpr (Entity User) u.id SqlExpr (Value (Key User)) -> SqlExpr (Value (Key User)) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) ==. Int64 -> SqlExpr (Value (Key User)) forall entity. (ToBackendKey SqlBackend entity, PersistField (Key entity)) => Int64 -> SqlExpr (Value (Key entity)) valkey UserID user.unID let follows :: SqlExpr (Value Bool) follows = SqlExpr (Entity User) -> Maybe UserID -> SqlExpr (Value Bool) forall a. ComparableUserEntity a => SqlExpr a -> Maybe UserID -> SqlExpr (Value Bool) queryIfUserFollows SqlExpr (Entity User) u Maybe UserID currUserID (SqlExpr (Entity User), SqlExpr (Value Bool)) -> SqlQuery (SqlExpr (Entity User), SqlExpr (Value Bool)) forall a. a -> SqlQuery a forall (f :: * -> *) a. Applicative f => a -> f a pure (SqlExpr (Entity User) u, SqlExpr (Value Bool) follows)