1
1
mirror of https://github.com/urbit/shrub.git synced 2024-12-27 22:21:38 +03:00
shrub/pkg/arvo/app/hark-graph-hook.hoon
2021-01-28 16:13:57 +10:00

474 lines
12 KiB
Plaintext

:: hark-graph-hook: notifications for graph-store [landscape]
::
/- post, group-store, metadata=metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, mdl=metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
::
::
~% %hark-graph-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
::
+$ state-0
[%0 base-state-0]
::
+$ state-1
[%1 base-state-0]
::
+$ base-state-0
$: watching=(set [resource index:post])
mentions=_&
watch-on-self=_&
==
::
+$ notif-kind
[name=@t parent-lent=@ud mode=?(%each %count %none) watch=?]
::
++ scry
|* [[our=@p now=@da] =mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our) i.t.p (scot %da now) t.t.p)
::
++ scry-conversion
|= [[our=@p now=@da] desk=term =mark]
~+
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
::
--
::
=| state-1
=* state -
::
=<
%- agent:dbug
^- agent:gall
~% %hark-graph-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ on-init
:_ this
~[watch-graph:ha]
::
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=+ !<(old=versioned-state vase)
=| cards=(list card)
|-
?: ?=(%0 -.old)
%_ $
-.old %1
::
cards
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%rewatch-dms)]
==
:_ this(state old)
=. cards (flop cards)
%+ welp
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
cards
[watch-graph:ha cards]
%+ turn
^- (list mark)
:~ %graph-validator-chat
%graph-validator-link
%graph-validator-publish
==
|= =mark
^- card
=/ =wire /validator/[mark]
=/ =rave:clay [%sing %c [%da now.bowl] /[mark]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
::
[%updates ~]
:_ state
%+ give:ha ~
:* %initial
watching
mentions
watch-on-self
==
==
[cards this]
::
++ on-poke
~/ %hark-graph-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-graph-hook-action
(hark-graph-hook-action !<(action:hook vase))
%noun
(poke-noun !<(* vase))
==
[cards this]
::
++ poke-noun
|= non=*
?> ?=(%rewatch-dms non)
=/ graphs=(list resource)
~(tap in get-keys:gra)
:- ~
%_ state
watching
%- ~(gas in watching)
(murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
==
::
++ hark-graph-hook-action
|= =action:hook
^- (quip card _state)
|^
:- (give:ha ~[/updates] action)
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
%set-mentions (set-mentions +.action)
%set-watch-on-self (set-watch-on-self +.action)
==
++ listen
|= [graph=resource =index:post]
^+ state
state(watching (~(put in watching) [graph index]))
::
++ ignore
|= [graph=resource =index:post]
^+ state
state(watching (~(del in watching) [graph index]))
::
++ set-mentions
|= ment=?
^+ state
state(mentions ment)
::
++ set-watch-on-self
|= self=?
^+ state
state(watch-on-self self)
--
--
::
++ on-agent
~/ %hark-graph-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?. ?=([%graph ~] wire)
~
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
[cards this]
==
::
++ graph-update
|= =update:graph-store
^- (quip card _state)
?+ -.q.update `state
%add-graph (add-graph resource.q.update)
::
?(%remove-graph %archive-graph)
(remove-graph resource.q.update)
::
%remove-nodes
(remove-nodes resource.q.update indices.q.update)
::
%add-nodes
=* rid resource.q.update
(check-nodes ~(val by nodes.q.update) rid)
==
:: this is awful, but notification kind should always switch
:: on the index, so hopefully doesn't matter
:: TODO: rethink this
++ remove-nodes
|= [rid=resource indices=(set index:graph-store)]
=/ to-remove
%- ~(gas by *(set [resource index:graph-store]))
(turn ~(tap in indices) (lead rid))
:_ state(watching (~(dif in watching) to-remove))
=/ =tube:clay
(get-conversion:ha rid)
%+ roll
~(tap in indices)
|= [=index:graph-store out=(list card)]
=| =indexed-post:graph-store
=. index.p.indexed-post index
=+ !<(u-notif-kind=(unit notif-kind) (tube !>(indexed-post)))
?~ u-notif-kind out
=* notif-kind u.u-notif-kind
=/ =stats-index:store
[%graph rid (scag parent-lent.notif-kind index)]
?. ?=(%each mode.notif-kind) out
:_ out
(poke-hark %read-each stats-index index)
::
++ poke-hark
|= =action:store
^- card
[%pass / %agent [our.bowl %hark-store] %poke hark-action+!>(action)]
::
++ remove-graph
|= rid=resource
=/ unwatched
%- ~(gas in *(set [resource index:graph-store]))
%+ skim ~(tap in watching)
|= [r=resource idx=index:graph-store]
=(r rid)
:_ state(watching (~(dif in watching) unwatched))
^- (list card)
:- (poke-hark:ha %remove-graph rid)
%- zing
%+ turn ~(tap in unwatched)
|= [r=resource =index:graph-store]
(give:ha ~[/updates] %ignore r index)
::
++ add-graph
|= rid=resource
^- (quip card _state)
=/ graph=graph:graph-store :: graph in subscription is bunted
(get-graph-mop:gra rid)
=/ node=(unit node:graph-store)
(bind (peek:orm:graph-store graph) |=([@ =node:graph-store] node))
=^ cards state
(check-nodes (drop node) rid)
?. (should-watch:ha rid)
[cards state]
:_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~]))
::
::
++ check-nodes
|= $: nodes=(list node:graph-store)
rid=resource
==
=/ group=(unit resource)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
`state
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
abet:check:(abed:handle-update:ha rid nodes u.group module.u.metadatum)
--
::
++ on-peek on-peek:def
::
++ on-leave on-leave:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %c [%da now.bowl] /[validator]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
++ on-fail on-fail:def
--
::
|_ =bowl:gall
+* met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ get-conversion
|= rid=resource
^- tube:clay
=+ %^ scry [our now]:bowl
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
?~ mark
|=(v=vase !>(~))
(scry-conversion [our now]:bowl q.byk.bowl u.mark)
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-graph-hook-update+!>(update)]~
::
++ watch-graph
^- card
[%pass /graph %agent [our.bowl %graph-store] %watch /updates]
::
++ poke-hark
|= =action:store
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>(action)
::
++ is-mention
|= contents=(list content:post)
^- ?
?. mentions %.n
?~ contents %.n
?. ?=(%mention -.i.contents)
$(contents t.contents)
?: =(our.bowl ship.i.contents)
%.y
$(contents t.contents)
::
++ should-watch
|= rid=resource
^- ?
=/ group-rid=(unit resource)
(peek-group:met %graph rid)
?~ group-rid %.n
?| !(is-managed:grp u.group-rid)
&(watch-on-self =(our.bowl entity.rid))
==
::
++ handle-update
|_ $: rid=resource :: input
updates=(list node:graph-store)
group=resource
module=term
hark-pokes=(list action:store) :: output
new-watches=(list index:graph-store)
==
++ update-core .
::
++ abed
|= [r=resource upds=(list node:graph-store) grp=resource mod=term]
update-core(rid r, updates upds, group grp, module mod)
::
++ get-conversion
(^get-conversion rid)
::
++ abet
^- (quip card _state)
:_ state(watching (~(uni in watching) (silt (turn new-watches (lead rid)))))
^- (list card)
%+ welp (turn (flop hark-pokes) poke-hark)
%- zing
%+ turn (flop new-watches)
|=(=index:graph-store (give ~[/updates] [%listen rid index]))
::
++ hark
|= =action:store
^+ update-core
update-core(hark-pokes [action hark-pokes])
::
++ new-watch
|= =index:graph-store
update-core(new-watches [index new-watches])
::
++ check
|- ^+ update-core
?~ updates
update-core
=/ core=_update-core
(check-node i.updates)
=. updates.core t.updates
$(update-core core)
::
++ check-node-children
|= =node:graph-store
^+ update-core
?: ?=(%empty -.children.node)
update-core
=/ children=(list [=atom =node:graph-store])
(tap:orm:graph-store p.children.node)
|- ^+ update-core
?~ children
update-core
=. update-core (check-node node.i.children)
$(children t.children)
::
++ check-node
|= =node:graph-store
^+ update-core
=. update-core (check-node-children node)
=+ !< notif-kind=(unit notif-kind)
(get-conversion !>([0 post.node]))
?~ notif-kind
update-core
=/ desc=@t
?: (is-mention contents.post.node)
%mention
name.u.notif-kind
=* not-kind u.notif-kind
=/ parent=index:post
(scag parent-lent.not-kind index.post.node)
=/ notif-index=index:store
[%graph group rid module desc parent]
?: =(our.bowl author.post.node)
(self-post node notif-index [mode watch]:not-kind)
=. update-core
(update-unread-count not-kind notif-index [time-sent index]:post.node)
=? update-core
?| =(desc %mention)
(~(has in watching) [rid parent])
==
=/ =contents:store
[%graph (limo post.node ~)]
(add-unread notif-index [time-sent.post.node %.n contents])
update-core
::
++ update-unread-count
|= [=notif-kind =index:store time=@da ref=index:graph-store]
=/ =stats-index:store
(to-stats-index:store index)
?- mode.notif-kind
%count (hark %unread-count stats-index time)
%each (hark %unread-each stats-index ref time)
%none update-core
==
::
++ self-post
|= $: =node:graph-store
=index:store
mode=?(%count %each %none)
watch=?
==
^+ update-core
?: ?=(%none mode) update-core
=/ =stats-index:store
(to-stats-index:store index)
=. update-core
(hark %seen-index time-sent.post.node stats-index)
=? update-core ?=(%count mode)
(hark %read-count stats-index)
=? update-core &(watch watch-on-self)
(new-watch index.post.node)
update-core
::
++ add-unread
|= [=index:store =notification:store]
(hark %add-note index notification)
::
--
--