restore_graph_machine.bend
bendvy-ecs-core@0.1.0.0 · 113 lines · 0 definitions
1import Base
2import bendvy-ecs-core@0.1.0.0/decode_data.bend as D
3import bendvy-ecs-core@0.1.0.0/restore_graph_data.bend as R
4import bendvy-ecs-core@0.1.0.0/ordinary_machine_declaration.bend as Ordinary
5import bendvy-ecs-core@0.1.0.0/ordinary_machine_initialization.bend as Init
6import bendvy-ecs-core@0.1.0.0/machine.bend as M
7import bendvy-ecs-core@0.1.0.0/machine_stream.bend as Stream
8import bendvy-ecs-core@0.1.0.0/machine_stream_queue.bend as Queue
9import bendvy-ecs-core@0.1.0.0/owner_product.bend as Product
10
11type Dispatch is Data:Unhandled{} Valid{} Invalid{}
12type Schema<-Resources:Type,-read:Resources -> Resources & List<&2,D.Field>,-check:D.Field -> Dispatch,-clear:Resources -> Resources,-install:Resources -> List<&2,D.Field> -> Resources> is Data:
13 Schema{}
14def take_slot(~S:Data,~K:Data,~V:Data,state:Init.State<S,K,V>) -> Init.State<S,K,V> & M.Slot<S,K,V>:
15 Init.slot(~S,~K,~V,state)
16def cleared_stream(~V:Data,value:Stream.Stream<V>) -> Stream.Stream<V>:
17 match value:
18 case Stream.Stream{Queue.Queue{_,_,_,dropped,_},positions,frameStart}:Stream.Stream{Queue.Queue{[],[],0n,dropped,0n},positions,frameStart}
19def clear(~S:Data,~K:Data,~V:Data,state:Init.State<S,K,V>) -> Init.State<S,K,V>:
20 match state:
21 case Init.State{slot,stream,revision}:Init.State{M.reset(~S,~K,~V,slot),cleared_stream(~V,stream),revision}
22def encoded(~S:Data,~K:Data,~V:Data,~encode:V -> D.Raw,name:String,slot:M.Slot<S,K,V>) -> List<&2,D.Field>:
23 match slot:
24 case M.Missing{}:[]
25 case M.Present{value,_,_,_}:[D.Field{name,encode(value)}]
26def read(~S:Data,~K:Data,~V:Data,~encode:V -> D.Raw,~DeclaredOwner:Type,~take:DeclaredOwner -> DeclaredOwner & M.Slot<S,K,V>,~declaration:Ordinary.Declaration<S,K,V,DeclaredOwner,take>,state:Init.State<S,K,V>) -> Init.State<S,K,V> & List<&2,D.Field>:
27 match state:
28 case Init.State{+slot,+stream,+revision}:(Init.State{slot,stream,revision},encoded(~S,~K,~V,~encode,Ordinary.name(~S,~K,~V,~DeclaredOwner,~take,declaration),slot))
29def member(~V:Data,~same:V -> V -> Bool,+value:V,values:List<&2,V>) -> Bool:
30 match values:
31 case []:False{}
32 case other <> rest:Bool.or(same(value,other),member(~V,~same,value,rest))
33def permitted(~V:Data,~same:V -> V -> Bool,value:V,values:Maybe<&2,List<&2,V>>) -> Bool:
34 match values:
35 case None{}:True{}
36 case Some{values}:member(~V,~same,value,values)
37def selected(value:Bool) -> Dispatch:
38 match value:
39 case True{}:Valid{}
40 case False{}:Invalid{}
41def decoded(~V:Data,~same:V -> V -> Bool,values:Maybe<&2,List<&2,V>>,value:Maybe<&2,V>) -> Dispatch:
42 match value:
43 case None{}:Invalid{}
44 case Some{value}:selected(permitted(~V,~same,value,values))
45def checked(~V:Data,~decode:D.Raw -> Maybe<&2,V>,~same:V -> V -> Bool,values:Maybe<&2,List<&2,V>>,result:D.Checked) -> Dispatch:
46 match result:
47 case D.Rejected{_}:Invalid{}
48 case D.Accepted{raw}:decoded(~V,~same,values,decode(raw))
49def named(~V:Data,~decode:D.Raw -> Maybe<&2,V>,~same:V -> V -> Bool,found:Bool,values:Maybe<&2,List<&2,V>>,+raw:D.Raw,codec:D.Codec) -> Dispatch:
50 match found:
51 case False{}:Unhandled{}
52 case True{}:checked(~V,~decode,~same,values,D.validate(100000n,D.Continue{[D.Work{codec,raw,"$"}]},raw))
53def check(~S:Data,~K:Data,~V:Data,~codec:D.Codec,~decode:D.Raw -> Maybe<&2,V>,~same:V -> V -> Bool,~DeclaredOwner:Type,~take:DeclaredOwner -> DeclaredOwner & M.Slot<S,K,V>,~declaration:Ordinary.Declaration<S,K,V,DeclaredOwner,take>,field:D.Field) -> Dispatch:
54 match field:
55 case D.Field{name,raw}:named(~V,~decode,~same,String.eq(name,Ordinary.name(~S,~K,~V,~DeclaredOwner,~take,declaration)),Ordinary.values(~S,~K,~V,~DeclaredOwner,~take,declaration),raw,codec)
56def installed(~S:Data,~K:Data,~V:Data,state:Init.State<S,K,V>,value:V) -> Init.State<S,K,V>:
57 match state:
58 case Init.State{slot,stream,revision}:Init.State{Init.insertion_slot(~S,~K,~V,value,M.reset(~S,~K,~V,slot)),cleared_stream(~V,stream),1n+revision}
59def decoded_install(~S:Data,~K:Data,~V:Data,state:Init.State<S,K,V>,value:Maybe<&2,V>) -> Init.State<S,K,V>:
60 match value:
61 case None{}:state
62 case Some{value}:installed(~S,~K,~V,state,value)
63def install_named(~S:Data,~K:Data,~V:Data,~decode:D.Raw -> Maybe<&2,V>,found:Bool,state:Init.State<S,K,V>,raw:D.Raw) -> Init.State<S,K,V>:
64 match found:
65 case False{}:state
66 case True{}:decoded_install(~S,~K,~V,state,decode(raw))
67def install_loop(~S:Data,~K:Data,~V:Data,~decode:D.Raw -> Maybe<&2,V>,~DeclaredOwner:Type,~take:DeclaredOwner -> DeclaredOwner & M.Slot<S,K,V>,~declaration:Ordinary.Declaration<S,K,V,DeclaredOwner,take>,values:List<&2,D.Field>,state:Init.State<S,K,V>) -> Init.State<S,K,V>:
68 match values:
69 case []:state
70 case D.Field{name,raw} <> rest:install_loop(~S,~K,~V,~decode,~DeclaredOwner,~take,~declaration,rest,install_named(~S,~K,~V,~decode,String.eq(name,Ordinary.name(~S,~K,~V,~DeclaredOwner,~take,declaration)),state,raw))
71def install(~S:Data,~K:Data,~V:Data,~decode:D.Raw -> Maybe<&2,V>,~DeclaredOwner:Type,~take:DeclaredOwner -> DeclaredOwner & M.Slot<S,K,V>,~declaration:Ordinary.Declaration<S,K,V,DeclaredOwner,take>,state:Init.State<S,K,V>,values:List<&2,D.Field>) -> Init.State<S,K,V>:
72 install_loop(~S,~K,~V,~decode,~DeclaredOwner,~take,~declaration,values,state)
73def machine(~S:Data,~K:Data,~V:Data,~codec:D.Codec,~encode:V -> D.Raw,~decode:D.Raw -> Maybe<&2,V>,~same:V -> V -> Bool,~DeclaredOwner:Type,~take:DeclaredOwner -> DeclaredOwner & M.Slot<S,K,V>,~declaration:Ordinary.Declaration<S,K,V,DeclaredOwner,take>) -> Schema<Init.State<S,K,V>,read(~S,~K,~V,~encode,~DeclaredOwner,~take,~declaration),check(~S,~K,~V,~codec,~decode,~same,~DeclaredOwner,~take,~declaration),clear(~S,~K,~V),install(~S,~K,~V,~decode,~DeclaredOwner,~take,~declaration)>:
74 Schema{}
75def joined_read(~L:Type,~Right:Type,left:L,leftFields:List<&2,D.Field>,result:Right & List<&2,D.Field>) -> Product.Owner<L,Right> & List<&2,D.Field>:
76 match result:
77 case (right,rightFields):(Product.Owner{left,right},List.append(&2,D.Field,leftFields,rightFields))
78def left_read(~L:Type,~Right:Type,~readRight:Right -> Right & List<&2,D.Field>,right:Right,result:L & List<&2,D.Field>) -> Product.Owner<L,Right> & List<&2,D.Field>:
79 match result:
80 case (left,fields):joined_read(~L,~Right,left,fields,readRight(right))
81def product_read(~L:Type,~Right:Type,~readLeft:L -> L & List<&2,D.Field>,~readRight:Right -> Right & List<&2,D.Field>,owner:Product.Owner<L,Right>) -> Product.Owner<L,Right> & List<&2,D.Field>:
82 match owner:
83 case Product.Owner{left,right}:left_read(~L,~Right,~readRight,right,readLeft(left))
84def next_check(result:Dispatch,next:Unit -> Dispatch) -> Dispatch:
85 match result:
86 case Unhandled{}:next(Unit{})
87 case result:result
88def product_check(~left:D.Field -> Dispatch,~right:D.Field -> Dispatch,field:D.Field) -> Dispatch:
89 +value=field
90 next_check(left(value),_ => right(value))
91def product_clear(~L:Type,~Right:Type,~left:L -> L,~right:Right -> Right,owner:Product.Owner<L,Right>) -> Product.Owner<L,Right>:
92 match owner:
93 case Product.Owner{l,r}:Product.Owner{left(l),right(r)}
94def product_install(~L:Type,~Right:Type,~left:L -> List<&2,D.Field> -> L,~right:Right -> List<&2,D.Field> -> Right,owner:Product.Owner<L,Right>,fields:List<&2,D.Field>) -> Product.Owner<L,Right>:
95 match owner:
96 case Product.Owner{l,r}:
97 +values=fields
98 Product.Owner{left(l,values),right(r,values)}
99def product(~L:Type,~Right:Type,~readLeft:L -> L & List<&2,D.Field>,~checkLeft:D.Field -> Dispatch,~clearLeft:L -> L,~installLeft:L -> List<&2,D.Field> -> L,~readRight:Right -> Right & List<&2,D.Field>,~checkRight:D.Field -> Dispatch,~clearRight:Right -> Right,~installRight:Right -> List<&2,D.Field> -> Right,-left:Schema<L,readLeft,checkLeft,clearLeft,installLeft>,-right:Schema<Right,readRight,checkRight,clearRight,installRight>) -> Schema<Product.Owner<L,Right>,product_read(~L,~Right,~readLeft,~readRight),product_check(~checkLeft,~checkRight),product_clear(~L,~Right,~clearLeft,~clearRight),product_install(~L,~Right,~installLeft,~installRight)>:
100 Schema{}
101def field_checked(+field:D.Field,result:Dispatch) -> Maybe<&2,R.Error>:
102 match field result:
103 case D.Field{name,_} Unhandled{}:Some{R.UnknownMachine{name}}
104 case D.Field{name,raw} Invalid{}:Some{R.InvalidMachineState{name,raw}}
105 case _ Valid{}:None{}
106def continued(error:Maybe<&2,R.Error>,next:Unit -> Maybe<&2,R.Error>) -> Maybe<&2,R.Error>:
107 match error:
108 case Some{error}:Some{error}
109 case None{}:next(Unit{})
110def validate(~check:D.Field -> Dispatch,values:List<&2,D.Field>) -> Maybe<&2,R.Error>:
111 match values:
112 case []:None{}
113 case +field <> rest:continued(field_checked(field,check(field)),_ => validate(~check,rest))