urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-01 06:35:32 +03:00
Code Issues Packages Projects Releases Wiki Activity

graph: hooks compile and higher-order mark implementation first-pass

Browse Source
This commit is contained in:
Logan Allen 2020-07-06 19:31:57 -04:00
parent a7cbecc0e2
commit 39933ca848
7 changed files with 126 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
pkg/arvo/app/graph-push-hook.hoon
View File

@ -1,5 +1,10 @@
/- *resource
/+ store=graph-store, graph, group, default-agent, dbug, push-hook
/+ store=graph-store
/+ res=resource
/+ graph
/+ group
/+ default-agent
/+ dbug
/+ push-hook
~% %graph-push-hook-top ..is ~
|%
+$ card card:agent:gall
@ -39,8 +44,7 @@
|= =vase
^- ?
=/ =update:store !<(update:store vase)
?. ?=(%0 -.update) %.n
?- +<.update
?- -.q.update
%add-graph %.y
%remove-graph %.y
%add-nodes %.y
@ -54,38 +58,39 @@
%keys %.n
%tags %.n
%tag-queries %.n
%run-updates %.y
==
::
++ resource-for-update
|= =vase
^- (unit resource)
^- (unit resource:res)
=/ =update:store !<(update:store vase)
?. ?=(%0 -.update) ~
?- +<.update
%add-graph `resource.update
%remove-graph `resource.update
%add-nodes `resource.update
%remove-nodes `resource.update
%add-signatures `resource.uid.update
%remove-signatures `resource.uid.update
%archive-graph `resource.update
?- -.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 ~
%run-updates `resource.q.update
%keys ~
%tags ~
%tag-queries ~
==
::
++ initial-watch
|= [=path =resource]
|= [=path =resource:res]
^- vase
?> (can-join:grp resource src.bowl)
?~ path
:: new subscribe
=/ =graph:store (get-graph:graph resource)
!> ^- update:store
[%add-graph resource graph]
[%0 now.bowl [%add-graph resource graph ~]]
:: resubscribe
::
:: TODO: use action-log
@ -96,14 +101,13 @@
|= =vase
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?. ?=(%0 -.update) [~ this]
?+ +<.update [~ this]
?+ -.q.update [~ this]
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:resource resource.update)] ~]~
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
::
%archive-graph
:_ this
[%give %kick ~[resource+(en-path:resource resource.update)] ~]~
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--

100
pkg/arvo/app/graph-store.hoon
View File

@ -1,4 +1,4 @@
/+ store=graph-store, sigs=signatures, default-agent, dbug
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug
~% %graph-store-top ..is ~
|%
+$ card card:agent:gall
@ -80,21 +80,28 @@
::
:: NOTE: cannot send these updates as pokes
::
:: TODO: add ~| error message
%keys !!
%tags !!
%tag-queries !!
%keys ~|('cannot send %keys as poke' !!)
%tags ~|('cannot send %tags as poke' !!)
%tag-queries ~|('cannot send %tag-queries as poke' !!)
==
::
++ add-graph
|= [=resource:store =graph:store]
|= [=resource:store =graph:store mark=(unit mark:store)]
^- (quip card _state)
?< (~(has by archive) resource)
?< (~(has by graphs) resource)
:- (give [/updates /keys ~] [%add-graph resource graph])
%_ state
graphs (~(put by graphs) resource graph)
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
?> (validate-graph graph mark)
:_ %_ state
graphs (~(put by graphs) resource [graph mark])
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
==
^- (list card)
%- zing
:~ (give [/updates /keys ~] [%add-graph resource graph mark])
?~ mark ~
=/ wire (weld /graph (en-path:res resource))
=/ =rave:clay [%sing %b [%da now.bowl] /[u.mark]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
::
++ remove-graph
@ -109,10 +116,14 @@
==
::
++ add-nodes
|= [=time =resource:store nodes=(map index:store node:store)]
|= $: =time
=resource:store
nodes=(map index:store node:store)
==
^- (quip card _state)
|^
=/ =graph:store (~(got by graphs) resource)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-nodes resource nodes]])
@ -123,12 +134,13 @@
graphs
%+ ~(put by graphs)
resource
(add-node-list resource graph ~(tap by nodes))
[(add-node-list resource graph mark ~(tap by nodes)) mark]
==
::
++ add-node-list
|= $: =resource:store
=graph:store
mark=(unit mark:store)
node-list=(list [index:store node:store])
==
^- graph:store
@ -137,7 +149,7 @@
=* node +.i.node-list
%_ $
node-list t.node-list
graph (add-node-at-index graph index node ~)
graph (add-node-at-index graph index node ~ mark)
==
::
++ add-node-at-index
@ -145,9 +157,11 @@
=index:store
=node:store
parent-hash=(unit hash:store)
mark=(unit mark:store)
==
^- graph:store
?~ index graph
?> (validate-graph (gas:orm ~ [i.index node]~) mark)
=* atom i.index
%^ put:orm
graph
@ -186,8 +200,9 @@
|= [=time =resource:store indices=(set index:store)]
^- (quip card _state)
|^
=/ =graph:store (~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%remove-nodes resource indices]])
::
@ -197,7 +212,7 @@
graphs
%+ ~(put by graphs)
resource
(remove-indices resource graph ~(tap in indices))
[(remove-indices resource graph ~(tap in indices)) mark]
==
::
++ remove-indices
@ -233,7 +248,8 @@
^- (quip card _state)
|^
=* resource resource.uid
=/ =graph:store (~(got by graphs) resource)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-signatures uid signatures]])
@ -242,7 +258,8 @@
%_ state
update-logs (~(put by update-logs) resource update-log)
graphs
(~(put by graphs) resource (add-at-index graph index.uid signatures))
%+ ~(put by graphs) resource
[(add-at-index graph index.uid signatures) mark]
==
::
++ add-at-index
@ -273,7 +290,8 @@
^- (quip card _state)
|^
=* resource resource.uid
=/ =graph:store (~(got by graphs) resource)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
%^ put:orm-log update-log
@ -285,7 +303,7 @@
update-logs (~(put by update-logs) resource update-log)
graphs
%+ ~(put by graphs) resource
(remove-at-index graph index.uid signatures)
[(remove-at-index graph index.uid signatures) mark]
==
::
++ remove-at-index
@ -379,6 +397,26 @@
==
==
::
++ validate-graph
|= [=graph:store mark=(unit mark:store)]
^- ?
?~ mark %.y
?~ graph %.y
=/ =dais:clay
.^ =dais:clay
%cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[u.mark]
==
%+ roll (tap:orm graph)
|= [[=atom:store =node:store] out=?]
?& out
=(%& (mule |.((vale:dais [atom post.node]))))
?- -.children.node
%empty %.y
%graph ^$(graph p.children.node)
==
==
::
++ give
|= [paths=(list path) update=update-0:store]
^- (list card)
@ -399,18 +437,18 @@
[%x %graph @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ graph=(unit graph:store) (~(get by graphs) [ship term])
=/ graph=(unit [graph:store *]) (~(get by graphs) [ship term])
?~ graph ~
``noun+!>(u.graph)
``noun+!>(-.u.graph)
::
[%x %graph-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit atom:store) (rush i.t.t.t.t.path dem:ag)
=/ end=(unit atom:store) (rush i.t.t.t.t.t.path dem:ag)
=/ graph=(unit graph:store) (~(get by graphs) [ship term])
=/ graph=(unit [graph:store *]) (~(get by graphs) [ship term])
?~ graph ~
``noun+!>(`graph:store`(subset:orm u.graph start end))
``noun+!>(`graph:store`(subset:orm -.u.graph start end))
::
[%x %node @ @ @ *]
=/ =ship (slav %p i.t.t.path)
@ -473,10 +511,10 @@
++ get-node
|= [=ship =term =index:store]
^- (unit node:store)
=/ parent-graph=(unit graph:store) (~(get by graphs) [ship term])
=/ parent-graph=(unit [graph:store *]) (~(get by graphs) [ship term])
?~ parent-graph ~
=/ node=(unit node:store) ~
=/ =graph:store u.parent-graph
=/ =graph:store -.u.parent-graph
|-
?~ index
node
@ -490,7 +528,13 @@
==
--
::
++ on-arvo on-arvo:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ -.sign-arvo (on-arvo:def wire sign-arvo)
%c [~ this]
==
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-fail on-fail:def

43
pkg/arvo/app/graph-view.hoon
View File

@ -1,4 +1,9 @@
/+ view=graph-view, store=graph-store, sigs=signatures, default-agent, dbug
/+ view=graph-view
/+ store=graph-store
/+ sigs=signatures
/+ grph=graph
/+ default-agent
/+ dbug
~% %graph-view-top ..is ~
|%
+$ card card:agent:gall
@ -21,6 +26,7 @@
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
gra ~(. grph bowl)
::
++ on-init
^- (quip card _this)
@ -157,7 +163,7 @@
++ scry-for-node
|= [=ship =term =index:store]
^- node:store
%+ scry-for node:store
%+ scry-for:gra node:store
%+ weld
/node/(scot %p ship)/[term]
(index-to-path index)
@ -170,7 +176,7 @@
=/ lngth=@ (dec (lent index))
=/ ind=index:store `(list atom)`(scag lngth `(list atom)`index)
=/ parent=node:store
%+ scry-for node:store
%+ scry-for:gra node:store
%+ weld
/node/(scot %p ship)/[term]
(index-to-path ind)
@ -207,7 +213,7 @@
^- (quip card _state)
?- -.typ
%all
=/ keys (scry-for resources:store /keys)
=/ keys (scry-for:gra resources:store /keys)
:_ state
:- (give con [%graph-update !>([%0 now.bowl [%keys keys]])])
%+ turn ~(tap in keys)
@ -219,21 +225,22 @@
:_ ~
%+ give con
:- %graph-update
!>([%0 now.bowl [%keys (scry-for resources:store /keys)]])
!>([%0 now.bowl [%keys (scry-for:gra resources:store /keys)]])
::
%tags
:_ state
:_ ~
%+ give con
:- %graph-update
!>([%0 now.bowl [%tags (scry-for (set term) /tags)]])
!>([%0 now.bowl [%tags (scry-for:gra (set term) /tags)]])
::
%tag-queries
:_ state
:_ ~
%+ give con
:- %graph-update
!>([%0 now.bowl [%tag-queries (scry-for tag-queries:store /tag-queries)]])
!>
[%0 now.bowl [%tag-queries (scry-for:gra tag-queries:store /tag-queries)]]
::
%graph
:_ state
@ -280,7 +287,7 @@
:- now.bowl
:+ %add-graph
[ship term]
(scry-for graph:store /graph/(scot %p ship)/[term])
[(scry-for:gra graph:store /graph/(scot %p ship)/[term]) ~]
::
++ graph-subset
|= [res=resource:store start=(unit atom:store) end=(unit atom:store)]
@ -292,7 +299,7 @@
res
start
end
%+ scry-for graph:store
%+ scry-for:gra graph:store
/graph-subset/(scot %p entity.res)/[name.res]/[st]/[en]
==
::
@ -303,7 +310,7 @@
:* %node
res
index
%+ scry-for node:store
%+ scry-for:gra node:store
%+ weld /node/(scot %p entity.res)/[name.res]
(turn index |=(=atom:store (scot %ud atom)))
==
@ -315,7 +322,7 @@
:* %post
res
index
%+ scry-for post:store
%+ scry-for:gra post:store
%+ weld /post/(scot %p entity.res)/[name.res]
(turn index |=(=atom:store (scot %ud atom)))
==
@ -327,7 +334,7 @@
:* %node-children
res
index
%+ scry-for graph:store
%+ scry-for:gra graph:store
%+ weld /node-children/(scot %p entity.res)/[name.res]
(turn index |=(=atom:store (scot %ud atom)))
==
@ -341,21 +348,11 @@
start
end
index
%+ scry-for graph:store
%+ scry-for:gra graph:store
%+ weld /node-children-subset/(scot %p entity.res)/[name.res]
(turn index |=(=atom:store (scot %ud atom)))
==
::
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%graph-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
::
++ give
|= [conn=atom:store =cage]
^- card

2
pkg/arvo/lib/graph-store.hoon
View File

@ -49,6 +49,7 @@
%- pairs
:~ [%resource (enjs:res resource.upd)]
[%graph (graph graph.upd)]
[%mark ?~(mark.upd ~ s+u.mark.upd)]
==
::
%remove-graph
@ -266,6 +267,7 @@
%- ot
:~ [%resource dejs:res]
[%graph graph]
[%mark (mu so)]
==
::
++ graph

4
pkg/arvo/lib/graph.hoon
View File

@ -1,4 +1,6 @@
|%
/- *resource
/+ store=graph-store
|_ =bowl:gall
++ scry-for
|* [=mold =path]
.^ mold

2
pkg/arvo/lib/hood/drum.hoon
View File

@ -105,6 +105,8 @@
%file-server
%graph-store
%graph-view
%graph-push-hook
%graph-pull-hook
==
::
++ deft-fish :: default connects

5
pkg/arvo/sur/graph-store.hoon
View File

@ -8,9 +8,10 @@
?> (check-balance:((ordered-map key value) ord) b)
b
::
+$ mark term
+$ graph ((mop atom node) gth)
+$ node [=post children=internal-graph]
+$ graphs (map resource graph)
+$ graphs (map resource [p=graph q=(unit mark)])
+$ tag-queries (jug term resource)
+$ update-log ((mop time logged-update) gth)
+$ update-logs (map resource update-log)
@ -45,7 +46,7 @@
::
+$ update-0
$% logged-update-0
[%add-graph =resource =graph]
[%add-graph =resource =graph mark=(unit mark)]
[%remove-graph =resource]
::
[%add-tag =term =resource]