graph-hooks: initial sketch

This commit is contained in:
Logan Allen 2020-08-19 12:22:20 -07:00
parent 7acb2da366
commit 928e5f7362
4 changed files with 180 additions and 1 deletions

View File

@ -0,0 +1,48 @@
/- *resource
/+ store=graph-store, graph, default-agent, verb, dbug, pull-hook
~% %graph-pull-hook-top ..is ~
|%
+$ card card:agent:gall
++ config
^- config:pull-hook
:* %graph-store
update:store
%graph-update
%graph-push-hook
==
--
::
%- agent:dbug
^- agent:gall
%- (agent:pull-hook config)
^- (pull-hook:pull-hook config)
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-pull-nack
|= [=resource =tang]
^- (quip card _this)
:_ this
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update -]~
^- update:store
!>([%0 now.bowl [%archive-graph resource])
::
++ on-pull-kick
|= =resource
^- (unit path)
=/ maybe-time (peek-log:graph resource)
?~ maybe-time `/
`/(scot %da u.maybe-time)
--

View File

@ -0,0 +1,116 @@
/+ store=graph-store
/+ res=resource
/+ graph
/+ group
/+ default-agent
/+ dbug
/+ push-hook
~% %graph-push-hook-top ..is ~
|%
+$ card card:agent:gall
++ config
^- config:push-hook
:* %graph-store
/updates
update:store
%graph-update
%graph-pull-hook
==
::
+$ agent (push-hook:push-hook config)
--
::
%- agent:dbug
^- agent:gall
%- (agent:push-hook config)
^- agent
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. group bowl)
gra ~(. graph bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
^- ?
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph %.y
%remove-graph %.y
%add-nodes %.y
%remove-nodes %.y
%add-signatures %.y
%remove-signatures %.y
%archive-graph %.y
%unarchive-graph %.n
%add-tag %.n
%remove-tag %.n
%keys %.n
%tags %.n
%tag-queries %.n
%run-updates %.y
==
::
++ resource-for-update
|= =vase
^- (unit resource:res)
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph `resource.q.update
%remove-graph `resource.q.update
%add-nodes `resource.q.update
%remove-nodes `resource.q.update
%add-signatures `resource.uid.q.update
%remove-signatures `resource.uid.q.update
%archive-graph `resource.q.update
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates `resource.q.update
==
::
++ initial-watch
|= [=path =resource:res]
^- vase
?> (can-join:grp resource src.bowl)
!> ^- update:store
?~ path
:: new subscribe
::
=/ [=graph:store mark=(unit mark:store)]
(get-graph:gra resource)
[%0 now.bowl [%add-graph resource graph mark]]
:: resubscribe
::
=/ =time (slav %da i.path)
=/ =update-log:store (get-update-log-subset:gra resource time)
[%0 now.bowl [%run-updates resource update-log]]
::
++ take-update
|= =vase
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?+ -.q.update [~ this]
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
::
%archive-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--

View File

@ -511,6 +511,15 @@
%empty [~ ~]
%graph ``noun+!>(`graph:store`(subset:orm p.children.u.node start end))
==
::
[%x %update-log-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit time) (slaw %da i.t.t.t.t.path)
=/ end=(unit time) (slaw %da i.t.t.t.t.t.path)
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
``noun+!>((subset:orm-log u.update-log start end))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)

View File

@ -17,8 +17,14 @@
%+ scry-for marked-graph:store
/graph/(scot %p entity.res)/[name.res]
::
++ peek-log
++ peek-update-log
|= res=resource
^- (unit time)
(scry-for (unit time) /peek-update-log/(scot %p entity.res)/[name.res])
::
++ get-update-log-subset
|= [res=resource start=@da]
^- update-log:store
%+ scry-for update-log:store
/update-log-subset/(scot %p entity.res)/[name.res]/(scot %da start)/'~'
--