relation_reorder.bend
bendvy-ecs-core@0.1.0.1 · 91 lines · 0 definitions
1import Base
2import bendvy-ecs-core@0.1.0.1/trace_relation.bend as TraceRel
3import bendvy-ecs-core@0.1.0.1/deferred_command.bend as Deferred
4import bendvy-ecs-core@0.1.0.1/trace_facts.bend as TraceFacts
5import entity_key.bend as Key
6import relation_types.bend as G
7import relation_reorder_core.bend as C
8import relation_commands.bend as A
9import world.bend as W
10import transaction.bend as X
11import capabilities.bend as Cap
12
13type Args<S:Data> is Data:
14 Args{parent:W.Handle<S>,children:List<&2,W.Handle<S>>}
15type Writable<H:Type,S:Data> is Type:
16 Writable{reorder:Cap.Request<H,Args<S>,A.QueueStatus>}
17def 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{}}
20def 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)
23def 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
29def 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}}])
33def 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)
36def 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)
39def 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))
43def 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)
46def 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)
49def 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)
52def 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))
55def 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))
58def 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))
60def 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))
64def 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))
67def 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))}
71def 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)}
74def 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})
77def 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{})
81def 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)
84def 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)
87def 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)
90def 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)