mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-28 08:54:51 +09:00
Support sharer-hosted tickets in AP local dispatch and delivery
This commit is contained in:
fr33domlover
parent
ef4a8f4015
commit
90bac5c34e
3 changed files with 122 additions and 66 deletions
|
|
@ -293,8 +293,8 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
|
|||
_ -> throwE "Local context isn't a ticket route"
|
||||
|
||||
atMostSharer :: e -> (ShrIdent, LocalSharerRelatedSet) -> ExceptT e Handler (Maybe ShrIdent)
|
||||
atMostSharer _ (shr, LocalSharerRelatedSet s [] []) = return $ if localRecipSharer s then Just shr else Nothing
|
||||
atMostSharer e (_ , LocalSharerRelatedSet _ _ _ ) = throwE e
|
||||
atMostSharer _ (shr, LocalSharerRelatedSet s [] [] []) = return $ if localRecipSharer s then Just shr else Nothing
|
||||
atMostSharer e (_ , LocalSharerRelatedSet _ _ _ _ ) = throwE e
|
||||
|
||||
verifyTicketRecipients :: (ShrIdent, PrjIdent, KeyHashid LocalTicket) -> LocalRecipientSet -> ExceptT Text Handler [ShrIdent]
|
||||
verifyTicketRecipients (shr, prj, num) recips = do
|
||||
|
|
@ -303,7 +303,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
|
|||
unless (prj == prj') $ throwE "Note project recipients mismatch context's project"
|
||||
unless (localRecipProject $ localRecipProjectDirect lprSet) $ throwE "Note context's project not addressed"
|
||||
unless (localRecipProjectFollowers $ localRecipProjectDirect lprSet) $ throwE "Note context's project followers not addressed"
|
||||
(num', ltrSet) <- verifySingleton (localRecipTicketRelated lprSet) "Note ticket-related recipient sets"
|
||||
(num', ltrSet) <- verifySingleton (localRecipProjectTicketRelated lprSet) "Note ticket-related recipient sets"
|
||||
unless (num == num') $ throwE "Note project recipients mismatch context's ticket number"
|
||||
unless (localRecipTicketTeam ltrSet) $
|
||||
throwE "Note ticket team not addressed"
|
||||
|
|
@ -973,7 +973,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
|
|||
, LocalProjectRelatedSet
|
||||
{ localRecipProjectDirect =
|
||||
LocalProjectDirectSet True True True
|
||||
, localRecipTicketRelated = []
|
||||
, localRecipProjectTicketRelated = []
|
||||
}
|
||||
)
|
||||
]
|
||||
|
|
@ -1006,7 +1006,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
|
|||
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
||||
return (obiid, doc, luAct)
|
||||
deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer recips = do
|
||||
(pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer projects _) -> do
|
||||
(pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer _ projects _) -> do
|
||||
(pids, remotes) <-
|
||||
traverseCollect (uncurry $ deliverLocalProject shr) projects
|
||||
pids' <- do
|
||||
|
|
|
|||
|
|
@ -719,7 +719,7 @@ deliverLocal
|
|||
]
|
||||
deliverLocal shrAuthor ibidAuthor _fsidAuthor obiid = deliverLocal' True (LocalActorSharer shrAuthor) ibidAuthor obiid . localRecipSieve sieve True
|
||||
where
|
||||
sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [])]
|
||||
sieve = [(shrAuthor, LocalSharerRelatedSet (LocalSharerDirectSet False True) [] [] [])]
|
||||
|
||||
data RemoteRecipient = RemoteRecipient
|
||||
{ remoteRecipientActor :: RemoteActorId
|
||||
|
|
@ -770,7 +770,7 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
|
|||
map (personInbox . entityVal) <$> selectList [PersonIdent <-. sids] [Asc PersonInbox]
|
||||
|
||||
getOtherInboxes :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
|
||||
getOtherInboxes (shr, LocalSharerRelatedSet _ projects repos) = do
|
||||
getOtherInboxes (shr, LocalSharerRelatedSet _ _ projects repos) = do
|
||||
msid <- getKeyBy $ UniqueSharer shr
|
||||
case msid of
|
||||
Nothing -> return []
|
||||
|
|
@ -806,15 +806,32 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
|
|||
map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] []
|
||||
|
||||
getOtherFollowerSets :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [FollowerSetId]
|
||||
getOtherFollowerSets (shr, LocalSharerRelatedSet _ projects repos) = do
|
||||
getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets projects repos) = do
|
||||
msid <- getKeyBy $ UniqueSharer shr
|
||||
case msid of
|
||||
Nothing -> return []
|
||||
Just sid ->
|
||||
(++)
|
||||
<$> getProjectFollowerSets sid projects
|
||||
Just sid -> do
|
||||
mpid <- getKeyBy $ UniquePersonIdent sid
|
||||
(\ t j r -> map E.unValue t ++ j ++ r)
|
||||
<$> case mpid of
|
||||
Nothing -> pure []
|
||||
Just pid -> getSharerTicketFollowerSets pid tickets
|
||||
<*> getProjectFollowerSets sid projects
|
||||
<*> getRepoFollowerSets sid repos
|
||||
where
|
||||
getSharerTicketFollowerSets pid tickets = do
|
||||
let talkhids =
|
||||
[talkhid | (talkhid, t) <- tickets
|
||||
, localRecipTicketFollowers t
|
||||
]
|
||||
talids <- catMaybes <$> traverse decodeKeyHashid talkhids
|
||||
E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup) -> do
|
||||
E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
|
||||
E.on $ tal E.^. TicketAuthorLocalTicket E.==. lt E.^. LocalTicketId
|
||||
E.where_ $
|
||||
tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
|
||||
E.isNothing (tup E.?. TicketUnderProjectId)
|
||||
return $ lt E.^. LocalTicketFollowers
|
||||
getProjectFollowerSets sid projects = do
|
||||
let prjsJ =
|
||||
[prj | (prj, j) <- projects
|
||||
|
|
@ -828,12 +845,12 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
|
|||
let prjsT =
|
||||
if requireOwner
|
||||
then
|
||||
[ (prj, localRecipTicketRelated j)
|
||||
[ (prj, localRecipProjectTicketRelated j)
|
||||
| (prj, j) <- projects
|
||||
, localRecipProject (localRecipProjectDirect j) || LocalActorProject shr prj == author
|
||||
]
|
||||
else
|
||||
map (second localRecipTicketRelated) projects
|
||||
map (second localRecipProjectTicketRelated) projects
|
||||
fsidssT <- for prjsT $ \ (prj, tickets) -> do
|
||||
mjid <- getKeyBy $ UniqueProject prj sid
|
||||
case mjid of
|
||||
|
|
@ -900,15 +917,20 @@ deliverLocal' requireOwner author ibidAuthor obiid recips = do
|
|||
toTuples (E.Value iid, E.Value h, E.Value raid, E.Value luA, E.Value luI, E.Value ms) = ((iid, h), RemoteRecipient raid luA luI ms)
|
||||
|
||||
getTeams :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [InboxId]
|
||||
getTeams (shr, LocalSharerRelatedSet _ projects repos) = do
|
||||
getTeams (shr, LocalSharerRelatedSet _ tickets projects repos) = do
|
||||
msid <- getKeyBy $ UniqueSharer shr
|
||||
case msid of
|
||||
Nothing -> return []
|
||||
Just sid ->
|
||||
LO.union
|
||||
<$> getProjectTeams sid projects
|
||||
Just sid -> do
|
||||
mpid <- getKeyBy $ UniquePersonIdent sid
|
||||
(\ t j r -> t `LO.union` j `LO.union` r)
|
||||
<$> case mpid of
|
||||
Nothing -> pure []
|
||||
Just pid -> getSharerTicketTeams pid tickets
|
||||
<*> getProjectTeams sid projects
|
||||
<*> getRepoTeams sid repos
|
||||
where
|
||||
getSharerTicketTeams _pid _tickets = pure []
|
||||
getProjectTeams sid projects = do
|
||||
let prjs =
|
||||
[prj | (prj, LocalProjectRelatedSet d ts) <- projects
|
||||
|
|
|
|||
|
|
@ -96,12 +96,16 @@ renderLocalActor (LocalActorProject shr prj) = ProjectR shr prj
|
|||
renderLocalActor (LocalActorRepo shr rp) = RepoR shr rp
|
||||
|
||||
data LocalPersonCollection
|
||||
= LocalPersonCollectionSharerFollowers ShrIdent
|
||||
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent
|
||||
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
|
||||
| LocalPersonCollectionTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket)
|
||||
| LocalPersonCollectionTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket)
|
||||
| LocalPersonCollectionRepoTeam ShrIdent RpIdent
|
||||
= LocalPersonCollectionSharerFollowers ShrIdent
|
||||
| LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal)
|
||||
| LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal)
|
||||
|
||||
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent
|
||||
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
|
||||
| LocalPersonCollectionProjectTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket)
|
||||
| LocalPersonCollectionProjectTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket)
|
||||
|
||||
| LocalPersonCollectionRepoTeam ShrIdent RpIdent
|
||||
| LocalPersonCollectionRepoFollowers ShrIdent RpIdent
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -109,14 +113,18 @@ parseLocalPersonCollection
|
|||
:: Route App -> Maybe LocalPersonCollection
|
||||
parseLocalPersonCollection (SharerFollowersR shr) =
|
||||
Just $ LocalPersonCollectionSharerFollowers shr
|
||||
parseLocalPersonCollection (SharerTicketTeamR shr talkhid) =
|
||||
Just $ LocalPersonCollectionSharerTicketTeam shr talkhid
|
||||
parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) =
|
||||
Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid
|
||||
parseLocalPersonCollection (ProjectTeamR shr prj) =
|
||||
Just $ LocalPersonCollectionProjectTeam shr prj
|
||||
parseLocalPersonCollection (ProjectFollowersR shr prj) =
|
||||
Just $ LocalPersonCollectionProjectFollowers shr prj
|
||||
parseLocalPersonCollection (ProjectTicketTeamR shr prj num) =
|
||||
Just $ LocalPersonCollectionTicketTeam shr prj num
|
||||
Just $ LocalPersonCollectionProjectTicketTeam shr prj num
|
||||
parseLocalPersonCollection (ProjectTicketParticipantsR shr prj num) =
|
||||
Just $ LocalPersonCollectionTicketFollowers shr prj num
|
||||
Just $ LocalPersonCollectionProjectTicketFollowers shr prj num
|
||||
parseLocalPersonCollection (RepoTeamR shr rp) =
|
||||
Just $ LocalPersonCollectionRepoTeam shr rp
|
||||
parseLocalPersonCollection (RepoFollowersR shr rp) =
|
||||
|
|
@ -124,13 +132,15 @@ parseLocalPersonCollection (RepoFollowersR shr rp) =
|
|||
parseLocalPersonCollection _ = Nothing
|
||||
|
||||
renderLocalPersonCollection :: LocalPersonCollection -> Route App
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj
|
||||
renderLocalPersonCollection (LocalPersonCollectionTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp
|
||||
renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerTicketTeam shr talkhid) = SharerTicketTeamR shr talkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectTeam shr prj) = ProjectTeamR shr prj
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectFollowers shr prj) = ProjectFollowersR shr prj
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectTicketTeam shr prj ltkhid) = ProjectTicketTeamR shr prj ltkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionProjectTicketFollowers shr prj ltkhid) = ProjectTicketParticipantsR shr prj ltkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionRepoTeam shr rp) = RepoTeamR shr rp
|
||||
renderLocalPersonCollection (LocalPersonCollectionRepoFollowers shr rp) = RepoFollowersR shr rp
|
||||
|
||||
parseLocalRecipient
|
||||
:: Route App -> Maybe (Either LocalActor LocalPersonCollection)
|
||||
|
|
@ -156,7 +166,7 @@ data LocalProjectRecipientDirect
|
|||
|
||||
data LocalProjectRecipient
|
||||
= LocalProjectDirect LocalProjectRecipientDirect
|
||||
| LocalTicketRelated (KeyHashid LocalTicket) LocalTicketRecipientDirect
|
||||
| LocalProjectTicketRelated (KeyHashid LocalTicket) LocalTicketRecipientDirect
|
||||
deriving (Eq, Ord)
|
||||
|
||||
data LocalRepoRecipientDirect
|
||||
|
|
@ -175,6 +185,7 @@ data LocalSharerRecipientDirect
|
|||
|
||||
data LocalSharerRecipient
|
||||
= LocalSharerDirect LocalSharerRecipientDirect
|
||||
| LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect
|
||||
| LocalProjectRelated PrjIdent LocalProjectRecipient
|
||||
| LocalRepoRelated RpIdent LocalRepoRecipient
|
||||
deriving (Eq, Ord)
|
||||
|
|
@ -196,6 +207,14 @@ groupedRecipientFromCollection
|
|||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionSharerFollowers shr) =
|
||||
LocalSharerRelated shr $ LocalSharerDirect LocalSharerFollowers
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionSharerTicketTeam shr talkhid) =
|
||||
LocalSharerRelated shr $
|
||||
LocalSharerTicketRelated talkhid LocalTicketTeam
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionSharerTicketFollowers shr talkhid) =
|
||||
LocalSharerRelated shr $
|
||||
LocalSharerTicketRelated talkhid LocalTicketFollowerz
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionProjectTeam shr prj) =
|
||||
LocalSharerRelated shr $ LocalProjectRelated prj $
|
||||
|
|
@ -205,13 +224,13 @@ groupedRecipientFromCollection
|
|||
LocalSharerRelated shr $ LocalProjectRelated prj $
|
||||
LocalProjectDirect LocalProjectFollowers
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionTicketTeam shr prj num) =
|
||||
(LocalPersonCollectionProjectTicketTeam shr prj num) =
|
||||
LocalSharerRelated shr $ LocalProjectRelated prj $
|
||||
LocalTicketRelated num LocalTicketTeam
|
||||
LocalProjectTicketRelated num LocalTicketTeam
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionTicketFollowers shr prj num) =
|
||||
(LocalPersonCollectionProjectTicketFollowers shr prj num) =
|
||||
LocalSharerRelated shr $ LocalProjectRelated prj $
|
||||
LocalTicketRelated num LocalTicketFollowerz
|
||||
LocalProjectTicketRelated num LocalTicketFollowerz
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionRepoTeam shr rp) =
|
||||
LocalSharerRelated shr $ LocalRepoRelated rp $
|
||||
|
|
@ -244,8 +263,10 @@ data LocalProjectDirectSet = LocalProjectDirectSet
|
|||
deriving Eq
|
||||
|
||||
data LocalProjectRelatedSet = LocalProjectRelatedSet
|
||||
{ localRecipProjectDirect :: LocalProjectDirectSet
|
||||
, localRecipTicketRelated :: [(KeyHashid LocalTicket, LocalTicketDirectSet)]
|
||||
{ localRecipProjectDirect
|
||||
:: LocalProjectDirectSet
|
||||
, localRecipProjectTicketRelated
|
||||
:: [(KeyHashid LocalTicket, LocalTicketDirectSet)]
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -268,9 +289,14 @@ data LocalSharerDirectSet = LocalSharerDirectSet
|
|||
deriving Eq
|
||||
|
||||
data LocalSharerRelatedSet = LocalSharerRelatedSet
|
||||
{ localRecipSharerDirect :: LocalSharerDirectSet
|
||||
, localRecipProjectRelated :: [(PrjIdent, LocalProjectRelatedSet)]
|
||||
, localRecipRepoRelated :: [(RpIdent, LocalRepoRelatedSet)]
|
||||
{ localRecipSharerDirect
|
||||
:: LocalSharerDirectSet
|
||||
, localRecipSharerTicketRelated
|
||||
:: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)]
|
||||
, localRecipProjectRelated
|
||||
:: [(PrjIdent, LocalProjectRelatedSet)]
|
||||
, localRecipRepoRelated
|
||||
:: [(RpIdent, LocalRepoRelatedSet)]
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -283,14 +309,16 @@ groupLocalRecipients
|
|||
(\ (LocalSharerRelated shr _) -> shr)
|
||||
(\ (LocalSharerRelated _ lsr) -> lsr)
|
||||
where
|
||||
lsr2set = mk . partitionEithers3 . map lsr2e . NE.toList
|
||||
lsr2set = mk . partitionEithers4 . map lsr2e . NE.toList
|
||||
where
|
||||
lsr2e (LocalSharerDirect d) = Left d
|
||||
lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr)
|
||||
lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr)
|
||||
mk (ds, ps, rs) =
|
||||
lsr2e (LocalSharerDirect d) = Left $ Left d
|
||||
lsr2e (LocalSharerTicketRelated talkhid ltr) = Left $ Right (talkhid, ltr)
|
||||
lsr2e (LocalProjectRelated prj lpr) = Right $ Left (prj, lpr)
|
||||
lsr2e (LocalRepoRelated rp lrr) = Right $ Right (rp, lrr)
|
||||
mk (ds, ts, ps, rs) =
|
||||
LocalSharerRelatedSet
|
||||
(lsrs2set ds)
|
||||
(map (second ltrs2set) $ groupWithExtract fst snd ts)
|
||||
(map (second lpr2set) $ groupWithExtract fst snd ps)
|
||||
(map (second lrr2set) $ groupWithExtract fst snd rs)
|
||||
where
|
||||
|
|
@ -301,10 +329,17 @@ groupLocalRecipients
|
|||
s { localRecipSharer = True }
|
||||
f s LocalSharerFollowers =
|
||||
s { localRecipSharerFollowers = True }
|
||||
ltrs2set = foldl' f initial
|
||||
where
|
||||
initial = LocalTicketDirectSet False False
|
||||
f s LocalTicketTeam =
|
||||
s { localRecipTicketTeam = True }
|
||||
f s LocalTicketFollowerz =
|
||||
s { localRecipTicketFollowers = True }
|
||||
lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList
|
||||
where
|
||||
lpr2e (LocalProjectDirect d) = Left d
|
||||
lpr2e (LocalTicketRelated num ltrs) = Right (num, ltrs)
|
||||
lpr2e (LocalProjectDirect d) = Left d
|
||||
lpr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
|
||||
mk ds ts =
|
||||
LocalProjectRelatedSet
|
||||
(lprs2set ds)
|
||||
|
|
@ -319,13 +354,6 @@ groupLocalRecipients
|
|||
s { localRecipProjectTeam = True }
|
||||
f s LocalProjectFollowers =
|
||||
s { localRecipProjectFollowers = True }
|
||||
ltrs2set = foldl' f initial
|
||||
where
|
||||
initial = LocalTicketDirectSet False False
|
||||
f s LocalTicketTeam =
|
||||
s { localRecipTicketTeam = True }
|
||||
f s LocalTicketFollowerz =
|
||||
s { localRecipTicketFollowers = True }
|
||||
lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap
|
||||
where
|
||||
unwrap (LocalRepoDirect d) = d
|
||||
|
|
@ -333,15 +361,16 @@ groupLocalRecipients
|
|||
f s LocalRepo = s { localRecipRepo = True }
|
||||
f s LocalRepoTeam = s { localRecipRepoTeam = True }
|
||||
f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
|
||||
partitionEithers3 = adapt . second partitionEithers . partitionEithers
|
||||
partitionEithers4 = adapt . bimap partitionEithers partitionEithers . partitionEithers
|
||||
where
|
||||
adapt (l1, (l2, l3)) = (l1, l2, l3)
|
||||
adapt ((l1, l2), (l3, l4)) = (l1, l2, l3, l4)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Parse URIs into a grouped recipient set
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
makeRecipientSet :: [LocalActor] -> [LocalPersonCollection] -> LocalRecipientSet
|
||||
makeRecipientSet
|
||||
:: [LocalActor] -> [LocalPersonCollection] -> LocalRecipientSet
|
||||
makeRecipientSet actors collections =
|
||||
groupLocalRecipients $
|
||||
map groupedRecipientFromActor actors ++
|
||||
|
|
@ -431,9 +460,10 @@ localRecipSieve sieve allowActors =
|
|||
LocalProjectRelatedSet (LocalProjectDirectSet j False False) []
|
||||
onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) =
|
||||
LocalRepoRelatedSet $ LocalRepoDirectSet r False False
|
||||
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) js rs) =
|
||||
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts js rs) =
|
||||
LocalSharerRelatedSet
|
||||
(LocalSharerDirectSet s False)
|
||||
[]
|
||||
(map (second onlyActorsJ) js)
|
||||
(map (second onlyActorsR) rs)
|
||||
|
||||
|
|
@ -442,17 +472,25 @@ localRecipSieve sieve allowActors =
|
|||
if allowActors
|
||||
then Just (shr, onlyActorsS s)
|
||||
else Nothing
|
||||
applySharerRelated shr (These (LocalSharerRelatedSet s' j' r') (LocalSharerRelatedSet s j r)) =
|
||||
applySharerRelated shr (These (LocalSharerRelatedSet s' t' j' r') (LocalSharerRelatedSet s t j r)) =
|
||||
Just
|
||||
( shr
|
||||
, LocalSharerRelatedSet
|
||||
(applySharer s' s)
|
||||
(mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t)
|
||||
(mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j)
|
||||
(mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r)
|
||||
)
|
||||
where
|
||||
applySharer (LocalSharerDirectSet s' f') (LocalSharerDirectSet s f) =
|
||||
LocalSharerDirectSet (s && (s' || allowActors)) (f && f')
|
||||
|
||||
applyTicketRelated ltkhid (These t' t) = Just (ltkhid, applyTicket t' t)
|
||||
where
|
||||
applyTicket (LocalTicketDirectSet t' f') (LocalTicketDirectSet t f) =
|
||||
LocalTicketDirectSet (t && t') (f && f')
|
||||
applyTicketRelated _ _ = Nothing
|
||||
|
||||
applyProjectRelated _ (This _) = Nothing
|
||||
applyProjectRelated prj (That j) =
|
||||
if allowActors
|
||||
|
|
@ -468,11 +506,7 @@ localRecipSieve sieve allowActors =
|
|||
where
|
||||
applyProject (LocalProjectDirectSet j' t' f') (LocalProjectDirectSet j t f) =
|
||||
LocalProjectDirectSet (j && (j' || allowActors)) (t && t') (f && f')
|
||||
applyTicketRelated ltkhid (These t' t) = Just (ltkhid, applyTicket t' t)
|
||||
where
|
||||
applyTicket (LocalTicketDirectSet t' f') (LocalTicketDirectSet t f) =
|
||||
LocalTicketDirectSet (t && t') (f && f')
|
||||
applyTicketRelated _ _ = Nothing
|
||||
|
||||
applyRepoRelated _ (This _) = Nothing
|
||||
applyRepoRelated rp (That r) =
|
||||
if allowActors
|
||||
|
|
|
|||
Loading…
Reference in a new issue