diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 5f089b3..ffefe42 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2019, 2022, 2023 by fr33domlover . + - Written in 2016, 2019, 2022, 2023, 2024 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -47,6 +48,7 @@ module Vervis.Handler.Project where import Control.Applicative +import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe @@ -57,7 +59,7 @@ import Data.ByteString (ByteString) import Data.Default.Class import Data.Foldable import Data.List -import Data.Maybe (fromMaybe) +import Data.Maybe import Data.Text (Text) import Data.Time.Clock import Data.Traversable @@ -662,7 +664,71 @@ getProjectChildrenR projectHash = do ) getHtml projectID project actor children = do + invites <- handlerToWidget $ runDB $ do + sources <- E.select $ E.from $ \ (source `E.InnerJoin` holder `E.LeftOuterJoin` deleg) -> do + E.on $ E.just (source E.^. SourceId) E.==. deleg E.?. SourceUsSendDelegatorSource + E.on $ source E.^. SourceId E.==. holder E.^. SourceHolderProjectSource + E.where_ $ + holder E.^. SourceHolderProjectProject E.==. E.val projectID E.&&. + E.isNothing (deleg E.?. SourceUsSendDelegatorId) + E.orderBy [E.asc $ source E.^. SourceId] + return source + for sources $ \ (Entity sourceID (Source role)) -> do + (child, accept) <- do + topic <- getSourceTopic sourceID + accept <- + case bimap fst fst topic of + Left localID -> isJust <$> getBy (UniqueSourceThemAcceptLocal localID) + Right remoteID -> isJust <$> getBy (UniqueSourceThemAcceptRemote remoteID) + (,accept) <$> bitraverse + (\ (_, e) -> do + jID <- + case e of + Left j -> pure j + Right _ -> error "I'm a Project but my child is a Group" + j <- getJust jID + actor <- getJust $ projectActor j + return (jID, actor) + ) + (\ (_, actorID) -> getRemoteActorData actorID) + topic + ((inviter, time), us) <- do + usOrThem <- + requireEitherAlt + (getKeyBy $ UniqueSourceOriginUs sourceID) + (getKeyBy $ UniqueSourceOriginThem sourceID) + "Neither us nor them" + "Both us and them" + (addOrActor, us) <- + case usOrThem of + Left usID -> (,True) <$> + requireEitherAlt + (fmap sourceUsGestureLocalAdd <$> getValBy (UniqueSourceUsGestureLocal usID)) + (fmap (sourceUsGestureRemoteActor &&& sourceUsGestureRemoteAdd) <$> getValBy (UniqueSourceUsGestureRemote usID)) + "Neither local not remote" + "Both local and remote" + Right themID -> (,False) <$> + requireEitherAlt + (fmap sourceThemGestureLocalAdd <$> getValBy (UniqueSourceThemGestureLocal themID)) + (fmap (sourceThemGestureRemoteActor &&& sourceThemGestureRemoteAdd) <$> getValBy (UniqueSourceThemGestureRemote themID)) + "Neither local not remote" + "Both local and remote" + (,us) <$> case addOrActor of + Left addID -> do + OutboxItem outboxID _ time <- getJust addID + Entity actorID actor <- getByJust $ UniqueActorOutbox outboxID + (,time) . Left . (,actor) <$> getLocalActor actorID + Right (actorID, addID) -> do + RemoteActivity _ _ time <- getJust addID + (,time) . Right <$> getRemoteActorData actorID + return (inviter, us, child, accept, time, role) $(widgetFile "project/children") + where + getRemoteActorData actorID = do + actor <- getJust actorID + object <- getJust $ remoteActorIdent actor + inztance <- getJust $ remoteObjectInstance object + return (inztance, object, actor) getProjectParentsR :: KeyHashid Project -> Handler TypedContent getProjectParentsR projectHash = do diff --git a/templates/project/children.hamlet b/templates/project/children.hamlet index 5a4a5d9..abd6eb4 100644 --- a/templates/project/children.hamlet +++ b/templates/project/children.hamlet @@ -1,6 +1,7 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2019, 2022, 2023 by fr33domlover . +$# Written in 2016, 2019, 2022, 2023, 2024 +$# by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -26,3 +27,30 @@ $# . #{show role} #{showDate since} ^{projectLinkFedW child} + +

Invites + + + + +
Inviter + Via + Invited child + Child accepted? + Role + Time + $forall (inviter, us, child, accept, time, role) <- invites +
^{actorLinkFedW inviter} + + $if us + Us + $else + Them + ^{projectLinkFedW child} + + $if accept + [x] + $else + [_] + #{show role} + #{showDate time}