mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-10 11:06:46 +09:00
UI: HomeR: Display personal invites
This commit is contained in:
parent
e65563cd19
commit
ce1e542401
2 changed files with 161 additions and 71 deletions
|
@ -137,7 +137,8 @@ getHomeR = do
|
||||||
where
|
where
|
||||||
personalOverview :: Entity Person -> Handler Html
|
personalOverview :: Entity Person -> Handler Html
|
||||||
personalOverview (Entity pid _person) = do
|
personalOverview (Entity pid _person) = do
|
||||||
permits <- runDB $ do
|
(permits, invites) <- runDB $ do
|
||||||
|
permits <- do
|
||||||
locals <- do
|
locals <- do
|
||||||
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
|
ls <- E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do
|
||||||
E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
|
E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic
|
||||||
|
@ -208,6 +209,71 @@ getHomeR = do
|
||||||
, exts
|
, exts
|
||||||
)
|
)
|
||||||
return $ locals ++ remotes
|
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) =
|
let (people, repos, decks, looms, projects, groups, others) =
|
||||||
partitionByActorType (view _4) (view _1) permits
|
partitionByActorType (view _4) (view _1) permits
|
||||||
if null people
|
if null people
|
||||||
|
@ -251,6 +317,23 @@ getHomeR = do
|
||||||
#{renderObjURI u}
|
#{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 :: Handler Html
|
||||||
getBrowseR = do
|
getBrowseR = do
|
||||||
(people, groups, repos, decks, looms, projects) <- runDB $
|
(people, groups, repos, decks, looms, projects) <- runDB $
|
||||||
|
|
|
@ -105,3 +105,10 @@ $# Comment on a ticket or merge request
|
||||||
$forall i <- others
|
$forall i <- others
|
||||||
<li>
|
<li>
|
||||||
^{item i}
|
^{item i}
|
||||||
|
|
||||||
|
<h2>Your invites
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall i <- invites
|
||||||
|
<li>
|
||||||
|
^{invite i}
|
||||||
|
|
Loading…
Reference in a new issue