:: group-hook: allow syncing group data from foreign paths to local paths :: /- *group-store, *group-hook |% +$ move [bone card] :: +$ card $% [%diff [%group-update group-update]] [%quit ~] [%poke wire dock [%group-action group-action]] [%pull wire dock ~] [%peer wire dock path] == :: +$ state $% [%0 state-zero] == :: +$ state-zero $: synced=(map path ship) boned=(map wire (list bone)) == :: -- :: |_ [bol=bowl:gall state] :: ++ this . :: ++ prep |= old=(unit state) ^- (quip move _this) ?~ old [~ this] [~ this(+<+ u.old)] :: ++ poke-group-hook-action |= act=group-hook-action ^- (quip move _this) ?- -.act %add ?. (team:title our.bol src.bol) [~ this] =/ group-path [%group path.act] =/ group-wire [(scot %p ship.act) group-path] ?: (~(has by synced) path.act) [~ this] =. synced (~(put by synced) path.act ship.act) :_ (track-bone group-wire) ?: =(ship.act our.bol) [ost.bol %peer group-wire [ship.act %group-store] group-path]~ [ost.bol %peer group-wire [ship.act %group-hook] group-path]~ :: %remove =/ ship (~(get by synced) path.act) ?~ ship [~ this] ?: &(=(u.ship our.bol) (team:title our.bol src.bol)) :: delete one of our own paths =/ group-wire [(scot %p our.bol) %group path.act] :_ this(synced (~(del by synced) path.act)) %+ weld (pull-wire group-wire path.act) ^- (list move) %+ turn (prey:pubsub:userlib [%group path.act] bol) |= [=bone *] ^- move [bone %quit ~] ?: |(=(u.ship src.bol) (team:title our.bol src.bol)) :: delete a foreign ship's path =/ group-wire [(scot %p u.ship) %group path.act] :_ this(synced (~(del by synced) path.act)) (pull-wire group-wire path.act) :: don't allow [~ this] == :: ++ peer-group |= pax=path ^- (quip move _this) ?~ pax !! ?> (~(has by synced) pax) =/ grp (group-scry pax) ?~ grp !! :_ this [ost.bol %diff [%group-update [%path u.grp pax]]]~ :: ++ diff-group-update |= [wir=wire diff=group-update] ^- (quip move _this) ?: (team:title our.bol src.bol) (handle-local diff) (handle-foreign diff) :: ++ handle-local |= diff=group-update ^- (quip move _this) ?- -.diff %keys [~ this] %path [~ this] %bundle [~ this] %add [(update-subscribers [%group pax.diff] diff) this] %remove [(update-subscribers [%group pax.diff] diff) this] :: %unbundle :_ this(synced (~(del by synced) pax.diff)) %+ weld (update-subscribers [%group pax.diff] diff) ^- (list move) %+ turn (prey:pubsub:userlib [%group pax.diff] bol) |= [=bone *] [bone %quit ~] == :: ++ handle-foreign |= diff=group-update ^- (quip move _this) ?- -.diff %keys [~ this] %bundle [~ this] :: %path :_ this ?~ pax.diff ~ =/ ship (~(get by synced) pax.diff) ?~ ship ~ ?. =(src.bol u.ship) ~ :~ (group-poke pax.diff [%unbundle pax.diff]) (group-poke pax.diff [%bundle pax.diff]) (group-poke pax.diff [%add members.diff pax.diff]) == :: %add :_ this ?~ pax.diff ~ =/ ship (~(get by synced) pax.diff) ?~ ship ~ ?. =(src.bol u.ship) ~ [(group-poke pax.diff diff)]~ :: %remove :_ this ?~ pax.diff ~ =/ ship (~(get by synced) pax.diff) ?~ ship ~ ?. =(src.bol u.ship) ~ [(group-poke pax.diff diff)]~ :: %unbundle ?~ pax.diff [~ this] =/ ship (~(get by synced) pax.diff) ?~ ship [~ this] ?. =(src.bol u.ship) [~ this] :_ this(synced (~(del by synced) pax.diff)) [(group-poke pax.diff diff)]~ == :: ++ quit |= wir=wire ^- (quip move _this) =^ =ship wir ?> ?=([* ^] wir) [(slav %p i.wir) t.t.wir] ?. (~(has by synced) wir) [~ this] =/ group-path [%group wir] =/ group-wire [(scot %p ship) group-path] :_ (track-bone group-wire) [ost.bol %peer group-wire [ship %group-hook] group-path]~ :: ++ reap |= [wir=wire saw=(unit tang)] ^- (quip move _this) ?~ saw [~ this] =^ =ship wir ?> ?=([* ^] wir) [(slav %p i.wir) t.t.wir] ~& %insufficient-permissions-for-group [((slog u.saw) ~) this(synced (~(del by synced) wir))] :: ++ group-poke |= [pax=path action=group-action] ^- move [ost.bol %poke pax [our.bol %group-store] [%group-action action]] :: ++ group-scry |= pax=path ^- (unit group) .^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun)) :: ++ update-subscribers |= [pax=path diff=group-update] ^- (list move) %+ turn (prey:pubsub:userlib pax bol) |= [=bone *] ^- move [bone %diff [%group-update diff]] :: ++ track-bone |= wir=wire ^+ this =/ bnd (~(get by boned) wir) ?^ bnd this(boned (~(put by boned) wir (snoc u.bnd ost.bol))) this(boned (~(put by boned) wir [ost.bol]~)) :: ++ pull-wire |= [wir=wire pax=path] ^- (list move) =/ bnd (~(get by boned) wir) ?~ bnd ~ =/ shp (~(get by synced) pax) ?~ shp ~ %+ turn u.bnd |= ost=bone ^- move ?: =(u.shp our.bol) [ost %pull wir [our.bol %group-store] ~] [ost %pull wir [u.shp %group-hook] ~] :: --