mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-10 17:36:46 +09:00
Support addressing, delivery and forwarding for sharer-patches and repo-patches
This commit is contained in:
fr33domlover
parent
d9c00cba1f
commit
06a051d2e5
3 changed files with 148 additions and 43 deletions
|
|
@ -1032,7 +1032,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
|
||||
|
|
|
|||
|
|
@ -808,7 +808,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
|
||||
|
|
@ -879,7 +879,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
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 []
|
||||
|
|
@ -915,24 +915,28 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
map (personFollowers . entityVal) <$> selectList [PersonIdent <-. sids] []
|
||||
|
||||
getOtherFollowerSets :: (ShrIdent, LocalSharerRelatedSet) -> AppDB [FollowerSetId]
|
||||
getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets projects repos) = do
|
||||
getOtherFollowerSets (shr, LocalSharerRelatedSet _ tickets patches projects repos) = do
|
||||
msid <- getKeyBy $ UniqueSharer shr
|
||||
case msid of
|
||||
Nothing -> return []
|
||||
Just sid -> do
|
||||
mpid <- getKeyBy $ UniquePersonIdent sid
|
||||
(\ t j r -> map E.unValue t ++ j ++ r)
|
||||
(\ tp j r -> map E.unValue tp ++ j ++ r)
|
||||
<$> case mpid of
|
||||
Nothing -> pure []
|
||||
Just pid -> getSharerTicketFollowerSets pid tickets
|
||||
Just pid -> getSharerTicketFollowerSets pid tickets patches
|
||||
<*> getProjectFollowerSets sid projects
|
||||
<*> getRepoFollowerSets sid repos
|
||||
where
|
||||
getSharerTicketFollowerSets pid tickets = do
|
||||
getSharerTicketFollowerSets pid tickets patches = do
|
||||
let talkhids =
|
||||
[talkhid | (talkhid, t) <- tickets
|
||||
, localRecipTicketFollowers t
|
||||
]
|
||||
++
|
||||
[talkhid | (talkhid, p) <- patches
|
||||
, localRecipPatchFollowers p
|
||||
]
|
||||
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
|
||||
|
|
@ -986,15 +990,51 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
E.isNothing (tar E.?. TicketAuthorRemoteId)
|
||||
)
|
||||
return $ lt E.^. LocalTicketFollowers
|
||||
getRepoFollowerSets sid repos =
|
||||
let rps =
|
||||
getRepoFollowerSets sid repos = do
|
||||
let rpsR =
|
||||
[rp | (rp, r) <- repos
|
||||
, let d = localRecipRepoDirect r
|
||||
in localRecipRepoFollowers d &&
|
||||
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
|
||||
]
|
||||
in map (repoFollowers . entityVal) <$>
|
||||
selectList [RepoSharer ==. sid, RepoIdent <-. rps] []
|
||||
fsidsR <-
|
||||
map (repoFollowers . entityVal) <$>
|
||||
selectList [RepoSharer ==. sid, RepoIdent <-. rpsR] []
|
||||
let rpsP =
|
||||
if requireOwner
|
||||
then
|
||||
[ (rp, localRecipRepoPatchRelated r)
|
||||
| (rp, r) <- repos
|
||||
, localRecipRepo (localRecipRepoDirect r) || isAuthor (LocalActorRepo shr rp)
|
||||
]
|
||||
else
|
||||
map (second localRecipRepoPatchRelated) repos
|
||||
fsidssP <- for rpsP $ \ (rp, patches) -> do
|
||||
mrid <- getKeyBy $ UniqueRepo rp sid
|
||||
case mrid of
|
||||
Nothing -> return []
|
||||
Just rid -> getPatchFollowerSets rid patches
|
||||
return $ fsidsR ++ map E.unValue (concat fsidssP)
|
||||
where
|
||||
getPatchFollowerSets rid patches = do
|
||||
let ltkhids =
|
||||
[ltkhid | (ltkhid, p) <- patches
|
||||
, localRecipPatchFollowers p
|
||||
]
|
||||
ltids <- catMaybes <$> traverse decodeKeyHashid ltkhids
|
||||
E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` tcl `E.InnerJoin` trl `E.LeftOuterJoin` tup `E.LeftOuterJoin` tar) -> do
|
||||
E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket
|
||||
E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tup E.?. TicketUnderProjectProject
|
||||
E.on $ tcl E.^. TicketContextLocalId E.==. trl E.^. TicketRepoLocalContext
|
||||
E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket
|
||||
E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
|
||||
E.where_ $
|
||||
trl E.^. TicketRepoLocalRepo E.==. E.val rid E.&&.
|
||||
E.not_
|
||||
( E.isNothing (tup E.?. TicketUnderProjectId) E.&&.
|
||||
E.isNothing (tar E.?. TicketAuthorRemoteId)
|
||||
)
|
||||
return $ lt E.^. LocalTicketFollowers
|
||||
|
||||
getLocalFollowers :: [FollowerSetId] -> AppDB [InboxId]
|
||||
getLocalFollowers fsids = do
|
||||
|
|
@ -1027,7 +1067,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
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 _ tickets projects repos) = do
|
||||
getTeams (shr, LocalSharerRelatedSet _ tickets _ projects repos) = do
|
||||
msid <- getKeyBy $ UniqueSharer shr
|
||||
case msid of
|
||||
Nothing -> return []
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ module Vervis.ActivityPub.Recipient
|
|||
( LocalActor (..)
|
||||
, LocalPersonCollection (..)
|
||||
, LocalTicketDirectSet (..)
|
||||
, LocalPatchDirectSet (..)
|
||||
, LocalProjectDirectSet (..)
|
||||
, LocalProjectRelatedSet (..)
|
||||
, LocalRepoDirectSet (..)
|
||||
|
|
@ -100,14 +101,16 @@ data LocalPersonCollection
|
|||
= LocalPersonCollectionSharerFollowers ShrIdent
|
||||
| LocalPersonCollectionSharerTicketTeam ShrIdent (KeyHashid TicketAuthorLocal)
|
||||
| LocalPersonCollectionSharerTicketFollowers ShrIdent (KeyHashid TicketAuthorLocal)
|
||||
| LocalPersonCollectionSharerPatchFollowers 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
|
||||
| LocalPersonCollectionRepoTeam ShrIdent RpIdent
|
||||
| LocalPersonCollectionRepoFollowers ShrIdent RpIdent
|
||||
| LocalPersonCollectionRepoPatchFollowers ShrIdent RpIdent (KeyHashid LocalTicket)
|
||||
deriving Eq
|
||||
|
||||
parseLocalPersonCollection
|
||||
|
|
@ -118,6 +121,8 @@ parseLocalPersonCollection (SharerTicketTeamR shr talkhid) =
|
|||
Just $ LocalPersonCollectionSharerTicketTeam shr talkhid
|
||||
parseLocalPersonCollection (SharerTicketFollowersR shr talkhid) =
|
||||
Just $ LocalPersonCollectionSharerTicketFollowers shr talkhid
|
||||
parseLocalPersonCollection (SharerPatchFollowersR shr talkhid) =
|
||||
Just $ LocalPersonCollectionSharerPatchFollowers shr talkhid
|
||||
parseLocalPersonCollection (ProjectTeamR shr prj) =
|
||||
Just $ LocalPersonCollectionProjectTeam shr prj
|
||||
parseLocalPersonCollection (ProjectFollowersR shr prj) =
|
||||
|
|
@ -130,18 +135,22 @@ parseLocalPersonCollection (RepoTeamR shr rp) =
|
|||
Just $ LocalPersonCollectionRepoTeam shr rp
|
||||
parseLocalPersonCollection (RepoFollowersR shr rp) =
|
||||
Just $ LocalPersonCollectionRepoFollowers shr rp
|
||||
parseLocalPersonCollection (RepoPatchFollowersR shr rp ltkhid) =
|
||||
Just $ LocalPersonCollectionRepoPatchFollowers shr rp ltkhid
|
||||
parseLocalPersonCollection _ = Nothing
|
||||
|
||||
renderLocalPersonCollection :: LocalPersonCollection -> Route App
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerFollowers shr) = SharerFollowersR shr
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerTicketTeam shr talkhid) = SharerTicketTeamR shr talkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerTicketFollowers shr talkhid) = SharerTicketFollowersR shr talkhid
|
||||
renderLocalPersonCollection (LocalPersonCollectionSharerPatchFollowers shr talkhid) = SharerPatchFollowersR 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
|
||||
renderLocalPersonCollection (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) = RepoPatchFollowersR shr rp ltkhid
|
||||
|
||||
parseLocalRecipient
|
||||
:: Route App -> Maybe (Either LocalActor LocalPersonCollection)
|
||||
|
|
@ -159,6 +168,8 @@ parseLocalRecipient r =
|
|||
data LocalTicketRecipientDirect = LocalTicketTeam | LocalTicketFollowerz
|
||||
deriving (Eq, Ord)
|
||||
|
||||
data LocalPatchRecipientDirect = LocalPatchFollowers deriving (Eq, Ord)
|
||||
|
||||
data LocalProjectRecipientDirect
|
||||
= LocalProject
|
||||
| LocalProjectTeam
|
||||
|
|
@ -176,7 +187,9 @@ data LocalRepoRecipientDirect
|
|||
| LocalRepoFollowers
|
||||
deriving (Eq, Ord)
|
||||
|
||||
data LocalRepoRecipient = LocalRepoDirect LocalRepoRecipientDirect
|
||||
data LocalRepoRecipient
|
||||
= LocalRepoDirect LocalRepoRecipientDirect
|
||||
| LocalRepoPatchRelated (KeyHashid LocalTicket) LocalPatchRecipientDirect
|
||||
deriving (Eq, Ord)
|
||||
|
||||
data LocalSharerRecipientDirect
|
||||
|
|
@ -187,6 +200,7 @@ data LocalSharerRecipientDirect
|
|||
data LocalSharerRecipient
|
||||
= LocalSharerDirect LocalSharerRecipientDirect
|
||||
| LocalSharerTicketRelated (KeyHashid TicketAuthorLocal) LocalTicketRecipientDirect
|
||||
| LocalSharerPatchRelated (KeyHashid TicketAuthorLocal) LocalPatchRecipientDirect
|
||||
| LocalProjectRelated PrjIdent LocalProjectRecipient
|
||||
| LocalRepoRelated RpIdent LocalRepoRecipient
|
||||
deriving (Eq, Ord)
|
||||
|
|
@ -216,6 +230,10 @@ groupedRecipientFromCollection
|
|||
(LocalPersonCollectionSharerTicketFollowers shr talkhid) =
|
||||
LocalSharerRelated shr $
|
||||
LocalSharerTicketRelated talkhid LocalTicketFollowerz
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionSharerPatchFollowers shr talkhid) =
|
||||
LocalSharerRelated shr $
|
||||
LocalSharerPatchRelated talkhid LocalPatchFollowers
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionProjectTeam shr prj) =
|
||||
LocalSharerRelated shr $ LocalProjectRelated prj $
|
||||
|
|
@ -240,6 +258,10 @@ groupedRecipientFromCollection
|
|||
(LocalPersonCollectionRepoFollowers shr rp) =
|
||||
LocalSharerRelated shr $ LocalRepoRelated rp $
|
||||
LocalRepoDirect LocalRepoFollowers
|
||||
groupedRecipientFromCollection
|
||||
(LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) =
|
||||
LocalSharerRelated shr $ LocalRepoRelated rp $
|
||||
LocalRepoPatchRelated ltkhid LocalPatchFollowers
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Recipient set types
|
||||
|
|
@ -256,6 +278,11 @@ data LocalTicketDirectSet = LocalTicketDirectSet
|
|||
}
|
||||
deriving Eq
|
||||
|
||||
newtype LocalPatchDirectSet = LocalPatchDirectSet
|
||||
{ localRecipPatchFollowers :: Bool
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
data LocalProjectDirectSet = LocalProjectDirectSet
|
||||
{ localRecipProject :: Bool
|
||||
, localRecipProjectTeam :: Bool
|
||||
|
|
@ -279,7 +306,10 @@ data LocalRepoDirectSet = LocalRepoDirectSet
|
|||
deriving Eq
|
||||
|
||||
data LocalRepoRelatedSet = LocalRepoRelatedSet
|
||||
{ localRecipRepoDirect :: LocalRepoDirectSet
|
||||
{ localRecipRepoDirect
|
||||
:: LocalRepoDirectSet
|
||||
, localRecipRepoPatchRelated
|
||||
:: [(KeyHashid LocalTicket, LocalPatchDirectSet)]
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -294,6 +324,8 @@ data LocalSharerRelatedSet = LocalSharerRelatedSet
|
|||
:: LocalSharerDirectSet
|
||||
, localRecipSharerTicketRelated
|
||||
:: [(KeyHashid TicketAuthorLocal, LocalTicketDirectSet)]
|
||||
, localRecipSharerPatchRelated
|
||||
:: [(KeyHashid TicketAuthorLocal, LocalPatchDirectSet)]
|
||||
, localRecipProjectRelated
|
||||
:: [(PrjIdent, LocalProjectRelatedSet)]
|
||||
, localRecipRepoRelated
|
||||
|
|
@ -310,17 +342,28 @@ groupLocalRecipients
|
|||
(\ (LocalSharerRelated shr _) -> shr)
|
||||
(\ (LocalSharerRelated _ lsr) -> lsr)
|
||||
where
|
||||
lsr2set = mk . partitionEithers4 . map lsr2e . NE.toList
|
||||
lsr2set = mk . partitionLSR . NE.toList
|
||||
where
|
||||
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) =
|
||||
partitionLSR = foldr f ([], [], [], [], [])
|
||||
where
|
||||
f i (ds, ts, ps, js, rs) =
|
||||
case i of
|
||||
LocalSharerDirect d ->
|
||||
(d:ds, ts, ps, js, rs)
|
||||
LocalSharerTicketRelated talkhid ltr ->
|
||||
(ds, (talkhid, ltr):ts, ps, js, rs)
|
||||
LocalSharerPatchRelated talkhid lpr ->
|
||||
(ds, ts, (talkhid, lpr):ps, js, rs)
|
||||
LocalProjectRelated prj ljr ->
|
||||
(ds, ts, ps, (prj, ljr):js, rs)
|
||||
LocalRepoRelated rp lrr ->
|
||||
(ds, ts, ps, js, (rp, lrr):rs)
|
||||
mk (ds, ts, ps, js, rs) =
|
||||
LocalSharerRelatedSet
|
||||
(lsrs2set ds)
|
||||
(map (second ltrs2set) $ groupWithExtract fst snd ts)
|
||||
(map (second lpr2set) $ groupWithExtract fst snd ps)
|
||||
(map (second lprs2set) $ groupWithExtract fst snd ps)
|
||||
(map (second ljr2set) $ groupWithExtract fst snd js)
|
||||
(map (second lrr2set) $ groupWithExtract fst snd rs)
|
||||
where
|
||||
lsrs2set = foldl' f initial
|
||||
|
|
@ -337,16 +380,20 @@ groupLocalRecipients
|
|||
s { localRecipTicketTeam = True }
|
||||
f s LocalTicketFollowerz =
|
||||
s { localRecipTicketFollowers = True }
|
||||
lpr2set = uncurry mk . partitionEithers . map lpr2e . NE.toList
|
||||
lprs2set = foldl' f initial
|
||||
where
|
||||
lpr2e (LocalProjectDirect d) = Left d
|
||||
lpr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
|
||||
initial = LocalPatchDirectSet False
|
||||
f s LocalPatchFollowers = s { localRecipPatchFollowers = True }
|
||||
ljr2set = uncurry mk . partitionEithers . map ljr2e . NE.toList
|
||||
where
|
||||
ljr2e (LocalProjectDirect d) = Left d
|
||||
ljr2e (LocalProjectTicketRelated num ltrs) = Right (num, ltrs)
|
||||
mk ds ts =
|
||||
LocalProjectRelatedSet
|
||||
(lprs2set ds)
|
||||
(ljrs2set ds)
|
||||
(map (second ltrs2set) $ groupWithExtract fst snd ts)
|
||||
where
|
||||
lprs2set = foldl' f initial
|
||||
ljrs2set = foldl' f initial
|
||||
where
|
||||
initial = LocalProjectDirectSet False False False
|
||||
f s LocalProject =
|
||||
|
|
@ -355,16 +402,21 @@ groupLocalRecipients
|
|||
s { localRecipProjectTeam = True }
|
||||
f s LocalProjectFollowers =
|
||||
s { localRecipProjectFollowers = True }
|
||||
lrr2set = LocalRepoRelatedSet . foldl' f initial . NE.map unwrap
|
||||
lrr2set = uncurry mk . partitionEithers . map lrr2e . NE.toList
|
||||
where
|
||||
unwrap (LocalRepoDirect d) = d
|
||||
initial = LocalRepoDirectSet False False False
|
||||
f s LocalRepo = s { localRecipRepo = True }
|
||||
f s LocalRepoTeam = s { localRecipRepoTeam = True }
|
||||
f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
|
||||
partitionEithers4 = adapt . bimap partitionEithers partitionEithers . partitionEithers
|
||||
where
|
||||
adapt ((l1, l2), (l3, l4)) = (l1, l2, l3, l4)
|
||||
lrr2e (LocalRepoDirect d) = Left d
|
||||
lrr2e (LocalRepoPatchRelated num ltrs) = Right (num, ltrs)
|
||||
mk ds ps =
|
||||
LocalRepoRelatedSet
|
||||
(lrrs2set ds)
|
||||
(map (second lprs2set) $ groupWithExtract fst snd ps)
|
||||
where
|
||||
lrrs2set = foldl' f initial
|
||||
where
|
||||
initial = LocalRepoDirectSet False False False
|
||||
f s LocalRepo = s { localRecipRepo = True }
|
||||
f s LocalRepoTeam = s { localRecipRepoTeam = True }
|
||||
f s LocalRepoFollowers = s { localRecipRepoFollowers = True }
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Parse URIs into a grouped recipient set
|
||||
|
|
@ -468,12 +520,13 @@ localRecipSieve' sieve allowSharers allowOthers =
|
|||
where
|
||||
onlyActorsJ (LocalProjectRelatedSet (LocalProjectDirectSet j _t _f) _ts) =
|
||||
LocalProjectRelatedSet (LocalProjectDirectSet (j && allowOthers) False False) []
|
||||
onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f)) =
|
||||
LocalRepoRelatedSet $ LocalRepoDirectSet (r && allowOthers) False False
|
||||
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts js rs) =
|
||||
onlyActorsR (LocalRepoRelatedSet (LocalRepoDirectSet r _t _f) _ps) =
|
||||
LocalRepoRelatedSet (LocalRepoDirectSet (r && allowOthers) False False) []
|
||||
onlyActorsS (LocalSharerRelatedSet (LocalSharerDirectSet s _f) _ts _ps js rs) =
|
||||
LocalSharerRelatedSet
|
||||
(LocalSharerDirectSet (s && allowSharers) False)
|
||||
[]
|
||||
[]
|
||||
(map (second onlyActorsJ) js)
|
||||
(map (second onlyActorsR) rs)
|
||||
|
||||
|
|
@ -482,12 +535,13 @@ localRecipSieve' sieve allowSharers allowOthers =
|
|||
if allowSharers || allowOthers
|
||||
then Just (shr, onlyActorsS s)
|
||||
else Nothing
|
||||
applySharerRelated shr (These (LocalSharerRelatedSet s' t' j' r') (LocalSharerRelatedSet s t j r)) =
|
||||
applySharerRelated shr (These (LocalSharerRelatedSet s' t' p' j' r') (LocalSharerRelatedSet s t p j r)) =
|
||||
Just
|
||||
( shr
|
||||
, LocalSharerRelatedSet
|
||||
(applySharer s' s)
|
||||
(mapMaybe (uncurry applyTicketRelated) $ sortAlign t' t)
|
||||
(mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
|
||||
(mapMaybe (uncurry applyProjectRelated) $ sortAlign j' j)
|
||||
(mapMaybe (uncurry applyRepoRelated) $ sortAlign r' r)
|
||||
)
|
||||
|
|
@ -501,6 +555,12 @@ localRecipSieve' sieve allowSharers allowOthers =
|
|||
LocalTicketDirectSet (t && t') (f && f')
|
||||
applyTicketRelated _ _ = Nothing
|
||||
|
||||
applyPatchRelated ltkhid (These p' p) = Just (ltkhid, applyPatch p' p)
|
||||
where
|
||||
applyPatch (LocalPatchDirectSet f') (LocalPatchDirectSet f) =
|
||||
LocalPatchDirectSet $ f && f'
|
||||
applyPatchRelated _ _ = Nothing
|
||||
|
||||
applyProjectRelated _ (This _) = Nothing
|
||||
applyProjectRelated prj (That j) =
|
||||
if allowOthers
|
||||
|
|
@ -522,8 +582,13 @@ localRecipSieve' sieve allowSharers allowOthers =
|
|||
if allowOthers
|
||||
then Just (rp, onlyActorsR r)
|
||||
else Nothing
|
||||
applyRepoRelated rp (These (LocalRepoRelatedSet r') (LocalRepoRelatedSet r)) =
|
||||
Just (rp, LocalRepoRelatedSet $ applyRepo r' r)
|
||||
applyRepoRelated rp (These (LocalRepoRelatedSet r' p') (LocalRepoRelatedSet r p)) =
|
||||
Just
|
||||
( rp
|
||||
, LocalRepoRelatedSet
|
||||
(applyRepo r' r)
|
||||
(mapMaybe (uncurry applyPatchRelated) $ sortAlign p' p)
|
||||
)
|
||||
where
|
||||
applyRepo (LocalRepoDirectSet r' t' f') (LocalRepoDirectSet r t f) =
|
||||
LocalRepoDirectSet (r && (r' || allowOthers)) (t && t') (f && f')
|
||||
|
|
|
|||
Loading…
Reference in a new issue