sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 04:14:52 +09:00
Code Issues Activity

UI: HomeR: Display personal invites

Browse source
This commit is contained in:
Pere Lev 2023-12-09 08:55:39 +02:00
parent e65563cd19
commit ce1e542401
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
2 changed files with 161 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
src/Vervis/Handler/Client.hs
View file

@ -137,7 +137,8 @@ getHomeR = do
where
personalOverview :: Entity Person -> Handler Html
personalOverview (Entity pid _person) = do
permits <- runDB $ do
(permits, invites) <- runDB $ do
permits <- do
locals <- do
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
@ -208,6 +209,71 @@ getHomeR = do
, exts
)
return $ locals ++ remotes
invites <- do
locals <- do
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. valid E.?. PermitTopicAcceptLocalTopic
E.on $ E.just (topic E.^. PermitTopicLocalId) E.==. enable E.?. PermitTopicEnableLocalTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit
E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
E.where_ $
permit E.^. PermitPerson E.==. E.val pid E.&&.
E.isNothing (enable E.?. PermitTopicEnableLocalId)
E.orderBy [E.asc $ permit E.^. PermitId]
return
( fulfills E.^. PermitFulfillsInviteId
, permit E.^. PermitRole
, valid E.?. PermitTopicAcceptLocalId
, accept E.?. PermitPersonGestureId
, topic E.^. PermitTopicLocalId
)
for ls $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value topicID) -> do
topic <- getPermitTopicLocal topicID
actorID <- do
ma <- getLocalActorEntity topic
case ma of
Nothing -> error "Impossible, we should have found the local actor in DB"
Just a -> pure $ localActorID a
actor <- getJust actorID
return
( fulfillsID
, role
, () <$ valid
, accept
, Left (topic, actor)
)
remotes <- do
rs <- E.select $ E.from $ \ (permit `E.InnerJoin` fulfills `E.InnerJoin` topic `E.LeftOuterJoin` enable `E.LeftOuterJoin` valid `E.LeftOuterJoin` accept) -> do
E.on $ E.just (permit E.^. PermitId) E.==. accept E.?. PermitPersonGesturePermit
E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. valid E.?. PermitTopicAcceptRemoteTopic
E.on $ E.just (topic E.^. PermitTopicRemoteId) E.==. enable E.?. PermitTopicEnableRemoteTopic
E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit
E.on $ permit E.^. PermitId E.==. fulfills E.^. PermitFulfillsInvitePermit
E.where_ $
permit E.^. PermitPerson E.==. E.val pid E.&&.
E.isNothing (enable E.?. PermitTopicEnableRemoteId)
E.orderBy [E.asc $ permit E.^. PermitId]
return
( fulfills E.^. PermitFulfillsInviteId
, permit E.^. PermitRole
, valid E.?. PermitTopicAcceptRemoteId
, accept E.?. PermitPersonGestureId
, topic E.^. PermitTopicRemoteActor
)
for rs $ \ (E.Value fulfillsID, E.Value role, E.Value valid, E.Value accept, E.Value remoteActorID) -> do
remoteActor <- getJust remoteActorID
remoteObject <- getJust $ remoteActorIdent remoteActor
inztance <- getJust $ remoteObjectInstance remoteObject
return
( fulfillsID
, role
, () <$ valid
, accept
, Right (inztance, remoteObject, remoteActor)
)
return $ sortOn (view _1) $ locals ++ remotes
return (permits, invites)
let (people, repos, decks, looms, projects, groups, others) =
partitionByActorType (view _4) (view _1) permits
if null people
@ -251,6 +317,23 @@ getHomeR = do
#{renderObjURI u}
|]
invite (_fulfillsID, role, valid, accept, actor) =
[whamlet|
<span>
[
#{show role}
] #
$maybe _ <- valid
\ [Valid] #
$nothing
\ [Not validated] #
$maybe _ <- accept
\ [You've accepted] #
$nothing
\ [Accept Button] [Reject Button] #
^{actorLinkFedW actor}
|]
getBrowseR :: Handler Html
getBrowseR = do
(people, groups, repos, decks, looms, projects) <- runDB $

7
templates/personal-overview.hamlet
View file

@ -105,3 +105,10 @@ $# Comment on a ticket or merge request
$forall i <- others
<li>
^{item i}
<h2>Your invites
<ul>
$forall i <- invites
<li>
^{invite i}