shrub/pkg/landscape/lib/graph.hoon
2021-08-11 19:23:36 +03:00

178 lines
4.0 KiB
Plaintext

/- *resource
/+ store=graph-store
|_ =bowl:gall
++ cg
|%
++ update
|= =update:store
^- cage
[%graph-update-2 !>(update)]
--
::
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%graph-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
::
++ resource-for-update
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph ~[resource.q.update]
%remove-graph ~[resource.q.update]
%add-nodes ~[resource.q.update]
%remove-posts ~[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]
==
::
++ upgrade
|* [pst=mold out-pst=mold]
=>
|%
++ orm
((ordered-map atom node) gth)
+$ node
[post=pst children=internal-graph]
+$ graph
((mop atom node) gth)
+$ internal-graph
$~ [%empty ~]
$% [%graph p=graph]
[%empty ~]
==
::
++ out-orm
((ordered-map atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
((mop atom out-node) gth)
+$ out-internal-graph
$~ [%empty ~]
$% [%graph p=out-graph]
[%empty ~]
==
--
|= $: gra=graph
fn=$-(pst out-pst)
==
^- out-graph
%- gas:out-orm
%+ turn (tap:orm gra)
|= [=atom =node]
:- (fn post.node)
?: ?=(%empty -.children.node)
[%empty ~]
$(gra p.children.node)
::
++ get-graph
|= res=resource
^- update:store
=- -(p *time)
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
++ get-graph-mop
|= res=resource
^- graph:store
=/ =update:store
(get-graph res)
?> ?=(%add-graph -.q.update)
graph.q.update
::
++ got-node
|= [res=resource =index:store]
^- node:store
=+ %+ scry-for ,=update:store
%+ weld
/graph/(scot %p entity.res)/[name.res]/node/index/kith
(turn index (cury scot %ud))
?> ?=(%add-nodes -.q.update)
?> ?=(^ nodes.q.update)
q.n.nodes.q.update
::
++ check-node-existence
|= [res=resource =index:store]
^- ?
%+ scry-for ,?
%+ weld
/graph/(scot %p entity.res)/[name.res]/node/exists
(turn index (cury scot %ud))
::
++ get-update-log
|= rid=resource
^- update-log:store
%+ scry-for update-log:store
/update-log/(scot %p entity.rid)/[name.rid]
::
++ peek-update-log
|= res=resource
^- (unit time)
(scry-for (unit time) /update-log/(scot %p entity.res)/[name.res]/latest)
::
++ get-update-log-subset
|= [res=resource start=@da]
^- update-log:store
%+ scry-for update-log:store
/update-log/(scot %p entity.res)/[name.res]/subset/'~'/(scot %da start)
::
++ get-keys
^- resources
=+ %+ scry-for ,=update:store
/keys
?> ?=(%keys -.q.update)
resources.q.update
::
++ tap-deep
|= [=index:store =graph:store]
^- (list [index:store node:store])
%+ roll (tap:orm:store graph)
|= $: [=atom =node:store]
lis=(list [index:store node:store])
==
=/ child-index (snoc index atom)
=/ childless-node node(children [%empty ~])
?: ?=(%empty -.children.node)
(snoc lis [child-index childless-node])
%+ weld
(snoc lis [child-index childless-node])
(tap-deep child-index p.children.node)
::
++ got-deep
|= [=graph:store =index:store]
^- node:store
=/ ind index
?> ?=(^ index)
=/ =node:store (need (get:orm:store graph `atom`i.index))
=. ind t.index
|- ^- node:store
?~ ind
node
?: ?=(%empty -.children.node)
!!
%_ $
ind t.ind
node (need (get:orm:store p.children.node i.ind))
==
::
++ get-mark
|= res=resource
(scry-for ,(unit mark) /graph/(scot %p entity.res)/[name.res]/mark)
--