1	import Base
2	import entity_key.bend as Key
3	import ./relation_types.bend as G
4	import ./relation_commands.bend as A
5	import ./relation_reorder.bend as Reorder
6	import ./world.bend as W
7	import ./capabilities.bend as Cap
8	import ./hierarchy_traversal.bend as T
9	import ./hierarchy_provider.bend as P
10	
11	# Separate traversal requests avoid computing unrelated snapshot fields.
12	# Descriptor and World remain hidden by the same rank-two authority boundary.
13	type Descendants<S:Data> is Data:
14	  Descendants{entity:W.Handle<S>,order:T.Order}
15	type Read<H:Type,S:Data> is Type:
16	  Read{root:Cap.Request<H,W.Handle<S>,Maybe<&2,W.Handle<S>>>,ancestors:Cap.Request<H,W.Handle<S>,Maybe<&2,P.Path<S>>>,descendants:Cap.Request<H,Descendants<S>,Maybe<&2,P.Path<S>>>}
17	type Selection is Data:
18	  Ancestors{}
19	  DescendantOrder{order:T.Order}
20	def selected(~S:Data,graph:G.Graph<S>,descriptor:G.Descriptor<S>,id:Key.Key,selection:Selection) -> T.Walk:
21	  match selection:
22	    case Ancestors{}: T.ancestors(~S,graph,descriptor,id)
23	    case DescendantOrder{order}: T.descendants(~S,graph,descriptor,id,order)
24	def store_path(~S:Data,~C:Type,store:A.Store<S,C>,descriptor:G.Descriptor<S>,target:W.Handle<S>,selection:Selection) -> A.Store<S,C> & P.Path<S>:
25	  match store target:
26	    case A.Store{components,+graph} W.Handle{+namespace,id}: (A.Store{components,graph},P.path(~S,selected(~S,graph,descriptor,id,selection),namespace))
27	def present_path(~S:Data,~C:Type,~R:Type,~E:Data,result:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & P.Path<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,P.Path<S>>:
28	  (world,value) = result
29	  (world,Some{value})
30	def checked_path(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,target:W.Handle<S>,selection:Selection) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,P.Path<S>>:
31	  match observed:
32	    case (world,False{}): (world,None{})
33	    case (world,True{}): present_path(~S,~C,~R,~E,W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~P.Path<S>,store => store_path(~S,~C,store,Reorder.descriptor(~S,descriptor),target,selection),world))
34	def lookup_path(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,target:W.Handle<S>,selection:Selection) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,P.Path<S>>:
35	  match target:
36	    case W.Handle{+namespace,+id}: checked_path(~S,~C,~R,~E,~descriptor,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,W.Handle{namespace,id}),W.Handle{namespace,id},selection)
37	def lookup_ancestors(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,target:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,P.Path<S>>:
38	  lookup_path(~S,~C,~R,~E,~descriptor,world,target,Ancestors{})
39	def lookup_descendants(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,request:Descendants<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,P.Path<S>>:
40	  match request:
41	    case Descendants{target,order}: lookup_path(~S,~C,~R,~E,~descriptor,world,target,DescendantOrder{order})
42	def store_root(~S:Data,~C:Type,store:A.Store<S,C>,descriptor:G.Descriptor<S>,target:W.Handle<S>) -> A.Store<S,C> & Maybe<&2,W.Handle<S>>:
43	  match store target:
44	    case A.Store{components,+graph} W.Handle{namespace,+id}: (A.Store{components,graph},P.handle(~S,T.root(T.ancestors(~S,graph,descriptor,id),id),namespace))
45	def checked_root(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,target:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,W.Handle<S>>:
46	  match observed:
47	    case (world,False{}): (world,None{})
48	    case (world,True{}): W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~Maybe<&2,W.Handle<S>>,store => store_root(~S,~C,store,Reorder.descriptor(~S,descriptor),target),world)
49	def lookup_root(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,target:W.Handle<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,W.Handle<S>>:
50	  match target:
51	    case W.Handle{+namespace,+id}: checked_root(~S,~C,~R,~E,~descriptor,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,W.Handle{namespace,id}),W.Handle{namespace,id})
52	def root(-H:Type,-S:Data,caps:Read<H,S>,owner:H,target:W.Handle<S>) -> H & Maybe<&2,W.Handle<S>>:
53	  match caps:
54	    case Read{Cap.Request{get},_,_}: get(owner,target)
55	def ancestors(-H:Type,-S:Data,caps:Read<H,S>,owner:H,target:W.Handle<S>) -> H & Maybe<&2,P.Path<S>>:
56	  match caps:
57	    case Read{_,Cap.Request{get},_}: get(owner,target)
58	def descendants(-H:Type,-S:Data,caps:Read<H,S>,owner:H,target:W.Handle<S>,order:T.Order) -> H & Maybe<&2,P.Path<S>>:
59	  match caps:
60	    case Read{_,_,Cap.Request{get}}: get(owner,Descendants{target,order})
61	def grant(~S:Data,~C:Type,~R:Type,~E:Data,~descriptor:G.HierarchyDescriptor<S>,~Out:Type,~body:@-H:Type -> Read<H,S> -> W.Handle<S> -> H -> H & Out,target:W.Handle<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Out:
62	  body(W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,Read{Cap.Request{lookup_root(~S,~C,~R,~E,~descriptor)},Cap.Request{lookup_ancestors(~S,~C,~R,~E,~descriptor)},Cap.Request{lookup_descendants(~S,~C,~R,~E,~descriptor)}},target,world)