diff --git a/pkg/arvo/app/graph-store.hoon b/pkg/arvo/app/graph-store.hoon index 9e374d1817..7f5ebf3eb4 100644 --- a/pkg/arvo/app/graph-store.hoon +++ b/pkg/arvo/app/graph-store.hoon @@ -28,6 +28,26 @@ ^- (quip card _this) [~ this(state !<(state-0 old))] :: +++ on-watch + ~/ %graph-store-watch + |= =path + ^- (quip card _this) + |^ + ?> (team:title our.bowl src.bowl) + =/ cards=(list card) + ?+ path (on-watch:def path) + [%updates ~] ~ + [%keys ~] (give [%keys ~(key by graphs)]) + [%tags ~] (give [%tags ~(key by tag-queries)]) + == + [cards this] + :: + ++ give + |= update=update-0:store + ^- (list card) + [%give %fact ~ [%graph-update !>([%0 update])]]~ + -- +:: ++ on-poke ~/ %graph-store-poke |= [=mark =vase] @@ -36,26 +56,32 @@ ?> (team:title our.bowl src.bowl) =^ cards state ?+ mark (on-poke:def mark vase) - %graph-action (graph-action !<(action:store vase)) + %graph-update (graph-update !<(update:store vase)) == [cards this] :: - ++ graph-action - |= =action:store + ++ graph-update + |= =update:store ^- (quip card _state) |^ - ?> ?=(%0 -.action) - ?- +<.action - %add-graph (add-graph +>.action) - %remove-graph (remove-graph +>.action) - %add-nodes (add-nodes +>.action) - %remove-nodes (remove-nodes +>.action) - %add-signatures (add-signatures +>.action) - %remove-signatures (remove-signatures +>.action) - %add-tag (add-tag +>.action) - %remove-tag (remove-tag +>.action) - %archive-graph (archive-graph +>.action) - %unarchive-graph (unarchive-graph +>.action) + ?> ?=(%0 -.update) + ?- +<.update + %add-graph (add-graph +>.update) + %remove-graph (remove-graph +>.update) + %add-nodes (add-nodes +>.update) + %remove-nodes (remove-nodes +>.update) + %add-signatures (add-signatures +>.update) + %remove-signatures (remove-signatures +>.update) + %add-tag (add-tag +>.update) + %remove-tag (remove-tag +>.update) + %archive-graph (archive-graph +>.update) + %unarchive-graph (unarchive-graph +>.update) + :: + :: NOTE: cannot send these updates as pokes + :: + %keys !! + %tags !! + %tag-queries !! == :: ++ add-graph @@ -281,7 +307,7 @@ |= [=term =resource:store] ^- (quip card _state) ?> (~(has by graphs) resource) - :- (give [/updates]~ [%add-tag term resource]) + :- (give [/updates /tags ~] [%add-tag term resource]) %_ state tag-queries (~(put ju tag-queries) term resource) == @@ -290,7 +316,7 @@ |= [=term =resource:store] ^- (quip card _state) ?> (~(has by graphs) resource) - :- (give [/updates]~ [%remove-tag term resource]) + :- (give [/updates /tags ~] [%remove-tag term resource]) %_ state tag-queries (~(del ju tag-queries) term resource) == @@ -300,11 +326,15 @@ ^- (quip card _state) ?< (~(has by archive) resource) ?> (~(has by graphs) resource) - :- (give [/updates /keys ~] [%archive-graph resource]) + :- (give [/updates /keys /tags ~] [%archive-graph resource]) %_ state archive (~(put by archive) resource (~(got by graphs) resource)) graphs (~(del by graphs) resource) action-logs (~(del by action-logs) resource) + tag-queries + %- ~(run by tag-queries) + |= =resources:store + (~(del in resources) resource) == :: ++ unarchive-graph @@ -326,32 +356,16 @@ -- -- :: -++ on-watch - ~/ %graph-store-watch - |= =path - ^- (quip card _this) - |^ - ?> (team:title our.bowl src.bowl) - =/ cards=(list card) - ?+ path (on-watch:def path) - [%updates ~] ~ - [%keys ~] (give [%keys ~(key by graphs)]) - == - [cards this] - :: - ++ give - |= update=update-0:store - ^- (list card) - [%give %fact ~ [%graph-update !>([%0 update])]]~ - -- -:: ++ on-peek ~/ %graph-store-peek |= =path ^- (unit (unit cage)) + |^ + ?> (team:title our.bowl src.bowl) ?+ path (on-peek:def path) - [%x %keys ~] ``noun+!>(~(key by graphs)) - [%x %tags ~] ``noun+!>(~(key by tag-queries)) + [%x %keys ~] ``noun+!>(~(key by graphs)) + [%x %tags ~] ``noun+!>(~(key by tag-queries)) + [%x %tag-queries ~] ``noun+!>(tag-queries) [%x %graph @ @ ~] =/ =ship (slav %p i.t.t.path) =/ =term i.t.t.t.path @@ -359,39 +373,75 @@ ?~ graph ~ ``noun+!>(u.graph) :: -:: [%x %graph-subset @ @ @ @ ~] -:: =/ =ship (slav %p i.t.t.path) -:: =/ =term i.t.t.t.path -:: :: TODO: parse out either '~' literal into null or parse out @ud -:: =/ start=(unit @ud) -:: =/ graph=(unit graph:store) (~(get by graphs) [ship term]) -:: ?~ graph ~ -:: ``noun+!>((subset:orm 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 ~ + ``noun+!>(`graph:store`(subset:orm u.graph start end)) :: [%x %node @ @ @ *] =/ =ship (slav %p i.t.t.path) =/ =term i.t.t.t.path =/ =index:store (turn t.t.t.t.path |=(=cord (slav %ud cord))) + =/ node=(unit node:store) (get-node ship term index) + ?~ node ~ + ``noun+!>(u.node) + :: + [%x %post @ @ @ *] + =/ =ship (slav %p i.t.t.path) + =/ =term i.t.t.t.path + =/ =index:store (turn t.t.t.t.path |=(=cord (slav %ud cord))) + =/ node=(unit node:store) (get-node ship term index) + ?~ node ~ + ``noun+!>(post.u.node) + :: + [%x %node-children @ @ @ *] + =/ =ship (slav %p i.t.t.path) + =/ =term i.t.t.t.path + =/ =index:store (turn t.t.t.t.path |=(=cord (slav %ud cord))) + =/ node=(unit node:store) (get-node ship term index) + ?~ node ~ + ?- -.children.u.node + %empty ~ + %graph ``noun+!>(p.children.u.node) + == + :: + [%x %node-children-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) + =/ =index:store (turn t.t.t.t.t.t.path |=(=cord (slav %ud cord))) + =/ node=(unit node:store) (get-node ship term index) + ?~ node ~ + ?- -.children.u.node + %empty ~ + %graph ``noun+!>(`graph:store`(subset:orm p.children.u.node start end)) + == + == + :: + ++ get-node + |= [=ship =term =index:store] + ^- (unit node:store) =/ parent-graph=(unit graph:store) (~(get by graphs) [ship term]) ?~ parent-graph ~ =/ node=(unit node:store) ~ =/ =graph:store u.parent-graph |- ?~ index - ?~ node ~ - ``noun+!>(u.node) + node ?~ t.index - =. node (get:orm graph i.index) - ?~ node ~ - ``noun+!>(u.node) + (get:orm graph i.index) =. node (get:orm graph i.index) ?~ node ~ ?- -.children.u.node %empty ~ %graph $(graph p.children.u.node, index t.index) == - == + -- :: ++ on-arvo on-arvo:def ++ on-agent on-agent:def diff --git a/pkg/arvo/app/graph-view.hoon b/pkg/arvo/app/graph-view.hoon index 4a233f7639..75d680435d 100644 --- a/pkg/arvo/app/graph-view.hoon +++ b/pkg/arvo/app/graph-view.hoon @@ -37,6 +37,45 @@ == == :: +++ on-watch + ~/ %graph-view-watch + |= =path + ^- (quip card _this) + ?> (team:title our.bowl src.bowl) + ?+ path (on-watch:def path) + [%updates @ ~] + :- [%give %fact ~ %json !>([(frond:enjs:format %graph-view s+'bound')])]~ + this(connections (~(put by connections) (slav %ud i.t.path) now.bowl)) + == +:: +++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card _this) + |^ + ?+ -.sign (on-agent:def wire sign) + %kick + :_ this + [%pass /updates %agent [our.bowl %graph-store] %watch /updates]~ + :: + %fact + ?+ p.cage.sign (on-agent:def wire sign) + %graph-update + :_ this + %+ give + %+ turn ~(tap by connections) + |= [=atom:store *] + ^- path + /updates/(scot %ud atom) + cage.sign + == + == + :: + ++ give + |= [paths=(list path) =cage] + ^- (list card) + [%give %fact paths cage]~ + -- +:: ++ on-poke ~/ %graph-view-poke |= [=mark =vase] @@ -45,23 +84,23 @@ ?> (team:title our.bowl src.bowl) =^ cards state ?+ mark (on-poke:def mark vase) - %graph-action (action !<(action:store vase)) - %json (action (action:dejs:store !<(json vase))) + %graph-update (update !<(update:store vase)) + %json (update (update:dejs:store !<(json vase))) %graph-view-action (view-action !<(action:view vase)) == [cards this] :: - ++ action - |= =action:store + ++ update + |= =update:store ^- (quip card _state) |^ :: TODO: decide who to send it to based on resource :: - ?> ?=(%0 -.action) + ?> ?=(%0 -.update) :_ state - ?+ +<.action [(poke-store action) ~] - %add-nodes (add-nodes +>.action) - %add-signatures (add-signatures +>.action) + ?+ +<.update [(poke-store update) ~] + %add-nodes (add-nodes +>.update) + %add-signatures (add-signatures +>.update) == :: ++ add-nodes @@ -147,14 +186,14 @@ (scot %ud i) :: ++ poke-store - |= =action:store + |= =update:store ^- card :* %pass /(scot %da now.bowl) %agent [our.bowl %graph-store] %poke - [%graph-action !>(action)] + [%graph-update !>(update)] == -- :: @@ -165,6 +204,149 @@ %fetch (fetch +.action) == :: + ++ fetch + |= [con=atom:store typ=query-type:view] + ^- (quip card _state) + ?- -.typ + %all + =/ keys (scry-for resources:store /keys) + :_ state + :- (give con [%graph-view-update !>([%0 [%keys keys]])]) + %+ turn ~(tap in keys) + |= [=ship =term] + (give con [%graph-update !>((add-graph ship term))]) + :: + %keys + :_ state + :_ ~ + %+ give con + :- %graph-view-update + !>([%0 [%keys (scry-for resources:store /keys)]]) + :: + %tags + :_ state + :_ ~ + %+ give con + :- %graph-view-update + !>([%0 [%tags (scry-for (set term) /tags)]]) + :: + %tag-queries + :_ state + :_ ~ + %+ give con + :- %graph-view-update + !>([%0 [%tag-queries (scry-for tag-queries:store /tag-queries)]]) + :: + %graph + :_ state + :_ ~ + (give con [%graph-update !>((add-graph resource.typ))]) + :: + %graph-subset + :_ state + :_ ~ + %+ give con + :- %graph-view-update + !>((graph-subset resource.typ start.typ end.typ)) + :: + %node + :_ state + :_ ~ + %+ give con + [%graph-view-update !>((node resource.typ index.typ))] + :: + %post + :_ state + :_ ~ + %+ give con + [%graph-view-update !>((post resource.typ index.typ))] + :: + %node-children + :_ state + :_ ~ + %+ give con + [%graph-view-update !>((node-children resource.typ index.typ))] + :: + %node-children-subset + :_ state + :_ ~ + %+ give con + :- %graph-view-update + !>((node-children-subset resource.typ start.typ end.typ index.typ)) + == + :: + ++ add-graph + |= [=ship =term] + ^- update:store + :- %0 + :+ %add-graph + [ship term] + (scry-for graph:store /graph/(scot %p ship)/[term]) + :: + ++ graph-subset + |= [res=resource:store start=(unit atom:store) end=(unit atom:store)] + ^- update:view + =/ st ?~(start %'~' (scot %ud u.start)) + =/ en ?~(end %'~' (scot %ud u.end)) + :- %0 + :* %graph-subset + res + start + end + %+ scry-for graph:store + /graph-subset/(scot %p entity.res)/[name.res]/[st]/[en] + == + :: + ++ node + |= [res=resource:store =index:store] + ^- update:view + :- %0 + :* %node + res + index + %+ scry-for node:store + %+ weld /node/(scot %p entity.res)/[name.res] + (turn index |=(=atom:store (scot %ud atom))) + == + :: + ++ post + |= [res=resource:store =index:store] + ^- update:view + :- %0 + :* %post + res + index + %+ scry-for post:store + %+ weld /post/(scot %p entity.res)/[name.res] + (turn index |=(=atom:store (scot %ud atom))) + == + :: + ++ node-children + |= [res=resource:store =index:store] + ^- update:view + :- %0 + :* %node-children + res + index + %+ scry-for graph:store + %+ weld /node-children/(scot %p entity.res)/[name.res] + (turn index |=(=atom:store (scot %ud atom))) + == + :: + ++ node-children-subset + |= [res=resource:store start=(unit atom) end=(unit atom) =index:store] + ^- update:view + :- %0 + :* %node-children-subset + res + start + end + index + %+ scry-for graph:store + %+ weld /node-children-subset/(scot %p entity.res)/[name.res] + (turn index |=(=atom:store (scot %ud atom))) + == + :: ++ scry-for |* [=mold =path] .^ mold @@ -175,69 +357,12 @@ (snoc `^path`path %noun) == :: - ++ fetch - |= [conn=atom:store type=fetch-type:view] - ^- (quip card _state) - =/ keys (scry-for resources:store /keys) - :_ state - :- (give conn [%graph-update !>([%0 [%keys keys]])]) - %+ turn ~(tap in keys) - |= [=ship =term] - (give conn [%graph-update !>((add-graph ship term))]) - :: - ++ add-graph - |= [=ship =term] - ^- update:store - :- %0 - :+ %add-graph - [ship term] - (scry-for graph:store /graph/(scot %p ship)/[term]) - :: ++ give |= [conn=atom:store =cage] ^- card [%give %fact [/updates/(scot %ud conn)]~ cage] -- :: -++ on-watch - ~/ %graph-view-watch - |= =path - ^- (quip card _this) - ?> (team:title our.bowl src.bowl) - ?+ path (on-watch:def path) - [%updates @ ~] - :- [%give %fact ~ %json !>([(frond:enjs:format %graph-view s+'bound')])]~ - this(connections (~(put by connections) (slav %ud i.t.path) now.bowl)) - == -:: -++ on-agent - |= [=wire =sign:agent:gall] - ^- (quip card _this) - |^ - ?+ -.sign (on-agent:def wire sign) - %kick - :_ this - [%pass /updates %agent [our.bowl %graph-store] %watch /updates]~ - :: - %fact - ?+ p.cage.sign (on-agent:def wire sign) - %graph-update - :_ this - %+ give - %+ turn ~(tap by connections) - |= [=atom:store *] - ^- path - /updates/(scot %ud atom) - cage.sign - == - == - :: - ++ give - |= [paths=(list path) =cage] - ^- (list card) - [%give %fact paths cage]~ - -- -:: ++ on-save !>(state) ++ on-load on-load:def ++ on-arvo on-arvo:def diff --git a/pkg/arvo/lib/graph-store.hoon b/pkg/arvo/lib/graph-store.hoon index 4c3ece07db..95b7f5daf1 100644 --- a/pkg/arvo/lib/graph-store.hoon +++ b/pkg/arvo/lib/graph-store.hoon @@ -29,7 +29,7 @@ == :: ++ orm ((or-map atom node) gth) -++ orm-log ((or-map time action) lth) +++ orm-log ((or-map time update) lth) :: ++ enjs =, enjs:format @@ -44,9 +44,6 @@ |= upd=update-0 ^- [cord json] ?- -.upd - %keys - [%keys [%a (turn ~(tap in resources.upd) enjs:res)]] - :: %add-graph :- %add-graph %- pairs @@ -104,6 +101,20 @@ :: %unarchive-graph [%unarchive-graph (enjs:res resource.upd)] + :: + %keys + [%keys [%a (turn ~(tap in resources.upd) enjs:res)]] + :: + %tags + [%tags [%a (turn ~(tap in tags.upd) |=(=term s+term))]] + :: + %tag-queries + :- %tag-queries + %- pairs + %+ turn ~(tap by tag-queries.upd) + |= [=term =resources] + ^- [cord json] + [term [%a (turn ~(tap in resources) enjs:res)]] == :: ++ graph @@ -222,11 +233,11 @@ ++ dejs =, dejs:format |% - ++ action + ++ update |= jon=json - ^- ^action + ^- ^update :- %0 - ^- action-0 + ^- update-0 =< (decode jon) |% ++ decode @@ -241,6 +252,9 @@ [%remove-tag remove-tag] [%archive-graph archive-graph] [%unarchive-graph unarchive-graph] + [%keys keys] + [%tags tags] + [%tag-queries tag-queries] == :: ++ add-graph @@ -354,6 +368,18 @@ :~ [%term so] [%resource dejs:res] == + :: + ++ keys + |= =json + *resources + :: + ++ tags + |= =json + *(set term) + :: + ++ tag-queries + |= =json + *^tag-queries -- -- :: diff --git a/pkg/arvo/lib/graph-view.hoon b/pkg/arvo/lib/graph-view.hoon index 1e2adc94e0..8a7e3f6460 100644 --- a/pkg/arvo/lib/graph-view.hoon +++ b/pkg/arvo/lib/graph-view.hoon @@ -1,4 +1,5 @@ /- sur=graph-view +/+ res=resource ^? =< [sur .] =, sur @@ -9,9 +10,9 @@ ++ action |= jon=json ^- ^action - =< (parse-json jon) + =< (decode jon) |% - ++ parse-json + ++ decode %- of :~ [%fetch fetch] == @@ -19,14 +20,44 @@ ++ fetch %- ot :~ [%connection ni] - [%type fetch-type] + [%type query-type] == :: - ++ fetch-type + ++ query-type %- of :~ [%all ul] + [%keys ul] + [%tags ul] + [%tag-queries ul] + [%graph dejs:res] + [%graph-subset graph-subset] + [%node node] + [%post node] + [%node-children node] + [%node-children-subset node-children-subset] + == + :: + ++ index (su ;~(pfix net (more net dem))) + ++ graph-subset + %- ot + :~ [%resource dejs:res] + [%start (mu ni)] + [%end (mu ni)] + == + :: + ++ node + %- ot + :~ [%resource dejs:res] + [%index index] + == + :: + ++ node-children-subset + %- ot + :~ [%resource dejs:res] + [%start (mu ni)] + [%end (mu ni)] + [%index index] == -- -- - -- diff --git a/pkg/arvo/mar/graph/action.hoon b/pkg/arvo/mar/graph/action.hoon deleted file mode 100644 index 136b31a10d..0000000000 --- a/pkg/arvo/mar/graph/action.hoon +++ /dev/null @@ -1,8 +0,0 @@ -/+ *graph-store -|_ act=action -++ grab - |% - ++ noun action - ++ json action:dejs - -- --- diff --git a/pkg/arvo/mar/graph/update.hoon b/pkg/arvo/mar/graph/update.hoon index 88deb6df16..d5f0f4abec 100644 --- a/pkg/arvo/mar/graph/update.hoon +++ b/pkg/arvo/mar/graph/update.hoon @@ -8,6 +8,6 @@ ++ grab |% ++ noun update + ++ json update:dejs -- -:: -- diff --git a/pkg/arvo/mar/graph/view-update.hoon b/pkg/arvo/mar/graph/view-update.hoon new file mode 100644 index 0000000000..59194f6d94 --- /dev/null +++ b/pkg/arvo/mar/graph/view-update.hoon @@ -0,0 +1,12 @@ +/+ *graph-view +|_ upd=update +++ grow + |% + ++ json (update:enjs upd) + -- +:: +++ grab + |% + ++ noun update + -- +-- diff --git a/pkg/arvo/sur/graph-store.hoon b/pkg/arvo/sur/graph-store.hoon index c1f0c76db4..261bc7bb4a 100644 --- a/pkg/arvo/sur/graph-store.hoon +++ b/pkg/arvo/sur/graph-store.hoon @@ -8,19 +8,12 @@ ?> (check-balance:((ordered-map key value) ord) b) b :: ++$ graph ((mop atom node) gth) ++$ node [=post children=internal-graph] +$ graphs (map resource graph) +$ tag-queries (jug term resource) ++$ action-log ((mop time update) lth) +$ action-logs (map resource action-log) -+$ network - $: =graphs - =tag-queries - =action-logs - archive=graphs - == -:: -+$ action-log ((mop time action) lth) -:: -+$ graph ((mop atom node) gth) :: +$ internal-graph $~ [%empty ~] @@ -28,13 +21,18 @@ [%empty ~] == :: -+$ node [=post children=internal-graph] -:: -+$ action - $% [%0 action-0] ++$ network + $: =graphs + =tag-queries + =action-logs + archive=graphs == :: -+$ action-0 ++$ update + $% [%0 update-0] + == +:: ++$ update-0 $% [%add-graph =resource =graph] [%remove-graph =resource] :: @@ -49,14 +47,11 @@ :: [%archive-graph =resource] [%unarchive-graph =resource] - == -:: -+$ update - $% [%0 update-0] - == -:: -+$ update-0 - $% [%keys =resources] - action-0 + :: + :: NOTE: cannot be sent as pokes + :: + [%keys =resources] + [%tags tags=(set term)] + [%tag-queries =tag-queries] == -- diff --git a/pkg/arvo/sur/graph-view.hoon b/pkg/arvo/sur/graph-view.hoon index 0530ffbf84..76113bd98a 100644 --- a/pkg/arvo/sur/graph-view.hoon +++ b/pkg/arvo/sur/graph-view.hoon @@ -1,9 +1,37 @@ +/- *graph-store, *post |% -+$ fetch-type ++$ query-type $% [%all ~] + [%keys ~] + [%tags ~] + [%tag-queries ~] + [%graph =resource] + [%graph-subset =resource start=(unit atom) end=(unit atom)] + [%node =resource =index] + [%post =resource =index] + [%node-children =resource =index] + [%node-children-subset =resource start=(unit atom) end=(unit atom) =index] == :: +$ action - $% [%fetch connection=@ type=fetch-type] + $% [%fetch connection=@ type=query-type] + == +:: ++$ update + $% [%0 update-0] + == +:: ++$ update-0 + $% [%graph-subset =resource start=(unit atom) end=(unit atom) =graph] + [%node =resource =index =node] + [%post =resource =index =post] + [%node-children =resource =index =graph] + $: %node-children-subset + =resource + start=(unit atom) + end=(unit atom) + =index + =graph + == == --