1	import Base
2	import ./trace_relation.bend as TraceRel
3	import ./deferred_command.bend as Deferred
4	import ./trace_facts.bend as TraceFacts
5	import entity_key.bend as Key
6	import relation_types.bend as G
7	import relation_reorder_core.bend as C
8	import relation_commands.bend as A
9	import world.bend as W
10	import transaction.bend as X
11	import capabilities.bend as Cap
12	
13	type Args<S:Data> is Data:
14	  Args{parent:W.Handle<S>,children:List<&2,W.Handle<S>>}
15	type Writable<H:Type,S:Data> is Type:
16	  Writable{reorder:Cap.Request<H,Args<S>,A.QueueStatus>}
17	def descriptor(~S:Data,value:G.HierarchyDescriptor<S>) -> G.Descriptor<S>:
18	  match value:
19	    case G.HierarchyDescriptor{key,name,inverse}: G.Descriptor{key,name,inverse,G.Hierarchy{}}
20	def store_reorder(~S:Data,~C:Type,store:A.Store<S,C>,d:G.Descriptor<S>,parent:Key.Key,children:List<&2,G.ChildStatus>,parentLive:Bool) -> A.Store<S,C> & Maybe<&2,G.Error>:
21	  match store:
22	    case A.Store{components,graph}: A.relate_result(~S,~C,C.reorder(~S,graph,d,parent,children,parentLive),components)
23	def error_target(error:G.Error,parent:Key.Key) -> Key.Key:
24	  match error:
25	    case G.MissingChildEntity{_,child,_}: child
26	    case G.DuplicateChild{_,child,_}: child
27	    case G.ChildNotRelatedToParent{_,child,_}: child
28	    case _: parent
29	def publish(~S:Data,~C:Type,~R:Type,~E:Data,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>,d:G.Descriptor<S>,+parent:Key.Key) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
30	  match observed:
31	    case (world,None{}): world
32	    case (world,Some{+error}): W.event_publish(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,[A.RelationFailed{G.Failure{d,G.ReorderChildren{},parent,error_target(error,parent),error}}])
33	def children_prepend(~S:Data,~C:Type,~R:Type,~E:Data,result:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.ChildStatus>,id:Key.Key,live:Bool) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.ChildStatus>:
34	  (world,rest) = result
35	  (world,G.ChildStatus{id,live} <> rest)
36	def child_next(~S:Data,~C:Type,~R:Type,~E:Data,checked:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,id:Key.Key,next:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.ChildStatus>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.ChildStatus>:
37	  (world,live) = checked
38	  children_prepend(~S,~C,~R,~E,next(world),id,live)
39	def child_statuses(~S:Data,~C:Type,~R:Type,~E:Data,children:List<&2,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>> & List<&2,G.ChildStatus>:
40	  match children:
41	    case []: (world,[])
42	    case W.Handle{+ns,+id} <> rest: child_next(~S,~C,~R,~E,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,W.Handle{ns,id}),id,world => child_statuses(~S,~C,~R,~E,rest,world))
43	def apply_children_result(~S:Data,~C:Type,~R:Type,~E:Data,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & List<&2,G.ChildStatus>,+d:G.Descriptor<S>,+parent:Key.Key,parentLive:Bool) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>:
44	  (world,children) = observed
45	  W.with_store(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,~Maybe<&2,G.Error>,store => store_reorder(~S,~C,store,d,parent,children,parentLive),world)
46	def apply_parent_result(~S:Data,~C:Type,~R:Type,~E:Data,checked:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Bool,d:G.Descriptor<S>,parent:Key.Key,children:List<&2,W.Handle<S>>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>:
47	  (world,live) = checked
48	  apply_children_result(~S,~C,~R,~E,child_statuses(~S,~C,~R,~E,children,world),d,parent,live)
49	def apply_result(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,args:Args<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>:
50	  match args:
51	    case Args{W.Handle{+ns,+parent},children}: apply_parent_result(~S,~C,~R,~E,W.valid(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world,W.Handle{ns,parent}),descriptor(~S,d),parent,children)
52	def apply_published(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,args:Args<S>,result:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
53	  match args:
54	    case Args{parent,_}:publish(~S,~C,~R,~E,result,descriptor(~S,d),W.handle_key(~S,parent))
55	def apply_traced(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,trace:TraceFacts.State,args:Args<S>,result:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & Maybe<&2,G.Error>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & TraceFacts.State:
56	  match args result:
57	    case Args{+parent,+children}, (world,+error):(publish(~S,~C,~R,~E,(world,error),descriptor(~S,d),W.handle_key(~S,parent)),TraceRel.reorder_applied(~S,trace,descriptor(~S,d),parent,children,error))
58	def apply(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,world:W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,+args:Args<S>) -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>:
59	  apply_published(~S,~C,~R,~E,~d,args,apply_result(~S,~C,~R,~E,~d,world,args))
60	def namespaces(~S:Data,children:List<&2,W.Handle<S>>,+namespace:U32) -> Bool:
61	  match children:
62	    case []: True{}
63	    case W.Handle{ns,_} <> rest: Bool.and(U32.is_eq(namespace,ns),namespaces(~S,rest,namespace))
64	def same_world(~S:Data,+args:Args<S>,+namespace:U32) -> Bool:
65	  match args:
66	    case Args{W.Handle{ns,_},children}: Bool.and(U32.is_eq(ns,namespace),namespaces(~S,children,namespace))
67	def reorder_command(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,enabled:Bool,+args:Args<S>) -> Deferred.Command<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>>:
68	  match enabled:
69	    case False{}:Deferred.Raw{world=>apply(~S,~C,~R,~E,~d,world,args)}
70	    case True{}:Deferred.Observed{trace=>world=>apply_traced(~S,~C,~R,~E,~d,trace,args,apply_result(~S,~C,~R,~E,~d,world,args))}
71	def reordered_stage(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,+args:Args<S>,result:TraceFacts.FactResult,tx:X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>:
72	  match args tx:
73	    case Args{parent,children} X.Tx{world,undo,commands,events,trace}:X.Tx{world,undo,commands,events,TraceRel.reorder(~S,trace,descriptor(~S,d),TraceFacts.StageOperation{},parent,children,result)}
74	def reorder_staged(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,+args:Args<S>,tx:X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>:
75	  match tx:
76	    case X.Tx{world,undo,commands,events,+trace}:reordered_stage(~S,~C,~R,~E,~d,args,TraceFacts.Attempted{},X.Tx{world,undo,reorder_command(~S,~C,~R,~E,~d,TraceFacts.enabled(trace),args) <> commands,events,trace})
77	def queued(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,same:Bool,tx:X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>,args:Args<S>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>> & A.QueueStatus:
78	  match same:
79	    case False{}: (reordered_stage(~S,~C,~R,~E,~d,args,TraceFacts.Refused{"MissingEntity"},tx),A.MissingEntity{})
80	    case True{}: (reorder_staged(~S,~C,~R,~E,~d,args,tx),A.Queued{})
81	def namespace_join(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,observed:W.World<S,A.Store<S,C>,R,A.Notice<S,E>> & U32,undo:List<(W.World<S,A.Store<S,C>,R,A.Notice<S,E>> -> W.World<S,A.Store<S,C>,R,A.Notice<S,E>>)>,commands:List<Deferred.Command<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>>>,events:List<&2,A.Notice<S,E>>,trace:TraceFacts.State,+args:Args<S>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>> & A.QueueStatus:
82	  (world,namespace) = observed
83	  queued(~S,~C,~R,~E,~d,same_world(~S,args,namespace),X.Tx{world,undo,commands,events,trace},args)
84	def queue(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,tx:X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>,args:Args<S>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>> & A.QueueStatus:
85	  match tx:
86	    case X.Tx{world,undo,commands,events,trace}: namespace_join(~S,~C,~R,~E,~d,W.namespace(~S,~A.Store<S,C>,~R,~A.Notice<S,E>,world),undo,commands,events,trace,args)
87	def body(~S:Data,-H:Type,caps:Writable<H,S>,args:Args<S>,owner:H) -> H & A.QueueStatus:
88	  match caps:
89	    case Writable{Cap.Request{reorder}}: reorder(owner,args)
90	def invoke(~S:Data,~C:Type,~R:Type,~E:Data,~d:G.HierarchyDescriptor<S>,~Out:Type,~client:@-H:Type -> Writable<H,S> -> Args<S> -> H -> H & Out,args:Args<S>,tx:X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>) -> X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>> & Out:
91	  client(X.Tx<W.World<S,A.Store<S,C>,R,A.Notice<S,E>>,A.Notice<S,E>>,Writable{Cap.Request{queue(~S,~C,~R,~E,~d)}},args,tx)