1	import Base
2	import ./json.bend as J
3	import ./split.bend as S
4	import ./head.bend as Hd
5	import ./fold.bend as K
6	
7	# Path expansion (spec section 13.4, decoder, mode "safe"): an unquoted key
8	# `a.b.c` whose segments are all identifiers becomes the nested object
9	# `{a: {b: {c: ..}}}`, and overlapping paths merge. A quoted key is literal.
10	#
11	# It is a pass over the decoded value, as in the reference decoder. Objects
12	# arrive with their quoted keys marked (head.bend), arrays and values are
13	# expanded first, then each field is flattened to leaf assignments
14	# (path, leaf) which are inserted in document order into the object being
15	# built. A conflict (a leaf where an object must be, an object where a leaf
16	# is, two leaves at one path) is an error in strict mode and last-write-wins
17	# otherwise.
18	
19	# ---- the path of a key -----------------------------------------------------------------
20	
21	def all_ident(+ks: List<&2, String>) -> Bool:
22	  match ks:
23	    case Nil{}:
24	      True{}
25	    case Con{k, t}:
26	      K.ident(k) && all_ident(t)
27	
28	# A bare key with a dot and only identifier segments expands.
29	def eligible(+k: String) -> Bool:
30	  K.has_dot(k) && all_ident(S.split(k, 46))
31	
32	def segs.bare(+e: Bool, +k: String) -> List<&2, String>:
33	  match e:
34	    case True{}:
35	      S.split(k, 46)
36	    case False{}:
37	      Con{k, Nil{}}
38	
39	def segs.pick(+quoted: Bool, +k: String) -> List<&2, String>:
40	  match quoted:
41	    case True{}:
42	      Con{Hd.unmark(k), Nil{}}
43	    case False{}:
44	      segs.bare(eligible(k), k)
45	
46	def segs_of(+k: String) -> List<&2, String>:
47	  segs.pick(Hd.marked(k), k)
48	
49	def snoc(+ks: List<&2, String>, +k: String) -> List<&2, String>:
50	  match ks:
51	    case Nil{}:
52	      Con{k, Nil{}}
53	    case Con{h, t}:
54	      Con{h, snoc(t, k)}
55	
56	# ---- inserting a leaf at a path ----------------------------------------------------------
57	
58	# The nested objects for a path ending in `leaf`.
59	def build(+segs: List<&2, String>, +leaf: J.Json) -> J.Json:
60	  match segs:
61	    case Nil{}:
62	      leaf
63	    case Con{s, rest}:
64	      J.JObj{J.JField{s, build(rest, leaf), J.JNil{}}}
65	
66	def conflict(+strict: Bool, +segs: List<&2, String>, +leaf: J.Json) -> Result<&2, &2, String, J.Json>:
67	  match strict:
68	    case True{}:
69	      Fail{"expansion conflict"}
70	    case False{}:
71	      Done{build(segs, leaf)}
72	
73	def empty_obj(+j: J.Json) -> Bool:
74	  match j:
75	    case J.JObj{J.JNil{}}:
76	      True{}
77	    case _:
78	      False{}
79	
80	# An existing object met by the end of a path: only an empty object leaf agrees.
81	def same.pick(+ok: Bool, +strict: Bool, +e: J.Json, +leaf: J.Json) -> Result<&2, &2, String, J.Json>:
82	  match ok:
83	    case True{}:
84	      Done{e}
85	    case False{}:
86	      conflict(strict, Nil{}, leaf)
87	
88	def wrap.obj(+r: Result<&2, &2, String, J.Json>) -> Result<&2, &2, String, J.Json>:
89	  match r:
90	    case Done{fs}:
91	      Done{J.JObj{fs}}
92	    case Fail{e}:
93	      Fail{e}
94	
95	# A cell of a field chain: replace the value when the key is the path's head,
96	# else look further along the chain.
97	def cell(+hit: Bool, +k: String, +ev: J.Json, +t: J.Json, +rv: Result<&2, &2, String, J.Json>, +rt: Result<&2, &2, String, J.Json>) -> Result<&2, &2, String, J.Json>:
98	  match hit rv rt:
99	    case True{} Done{v} _:
100	      Done{J.JField{k, v, t}}
101	    case True{} Fail{e} _:
102	      Fail{e}
103	    case False{} _ Done{t2}:
104	      Done{J.JField{k, ev, t2}}
105	    case False{} _ Fail{e}:
106	      Fail{e}
107	
108	# Insert `leaf` at `segs` inside `e`: an object value, a field chain, or
109	# whatever sits at the path (then it conflicts unless the path has ended).
110	def ins(+e: J.Json, +segs: List<&2, String>, +leaf: J.Json, +strict: Bool) -> Result<&2, &2, String, J.Json>:
111	  match e segs:
112	    case J.JObj{efs} Nil{}:
113	      same.pick(empty_obj(leaf), strict, e, leaf)
114	    case J.JObj{efs} Con{s, rest}:
115	      wrap.obj(ins(efs, segs, leaf, strict))
116	    case J.JField{k, ev, t} Con{s, rest}:
117	      cell(Hd.keq(k, s), k, ev, t, ins(ev, rest, leaf, strict), ins(t, segs, leaf, strict))
118	    case J.JNil{} Con{s, rest}:
119	      Done{J.JField{s, build(rest, leaf), J.JNil{}}}
120	    case J.JField{k, ev, t} Nil{}:
121	      Done{e}
122	    case J.JNil{} Nil{}:
123	      Done{e}
124	    case _ _:
125	      conflict(strict, segs, leaf)
126	
127	def ins.r(+acc: Result<&2, &2, String, J.Json>, +segs: List<&2, String>, +leaf: J.Json, +strict: Bool) -> Result<&2, &2, String, J.Json>:
128	  match acc:
129	    case Done{a}:
130	      ins(a, segs, leaf, strict)
131	    case Fail{e}:
132	      Fail{e}
133	
134	# Flatten an expanded value at `segs` into leaf assignments, inserted in order.
135	def fl.pick(+empty: Bool, +j: J.Json, +segs: List<&2, String>, +acc: Result<&2, &2, String, J.Json>, +strict: Bool, +r: Result<&2, &2, String, J.Json>) -> Result<&2, &2, String, J.Json>:
136	  match empty:
137	    case True{}:
138	      ins.r(acc, segs, j, strict)
139	    case False{}:
140	      r
141	
142	def fl(+j: J.Json, +segs: List<&2, String>, +acc: Result<&2, &2, String, J.Json>, +strict: Bool) -> Result<&2, &2, String, J.Json>:
143	  match j:
144	    case J.JObj{fs}:
145	      fl.pick(empty_obj(j), j, segs, acc, strict, fl(fs, segs, acc, strict))
146	    case J.JField{k, v, t}:
147	      fl(t, segs, fl(v, snoc(segs, k), acc, strict), strict)
148	    case J.JNil{}:
149	      acc
150	    case _:
151	      ins.r(acc, segs, j, strict)
152	
153	# ---- the pass ----------------------------------------------------------------------------
154	
155	def init() -> Result<&2, &2, String, J.Json>:
156	  Done{J.JObj{J.JNil{}}}
157	
158	def fl.r(+vr: Result<&2, &2, String, J.Json>, +segs: List<&2, String>, +acc: Result<&2, &2, String, J.Json>, +strict: Bool) -> Result<&2, &2, String, J.Json>:
159	  match vr:
160	    case Done{v}:
161	      fl(v, segs, acc, strict)
162	    case Fail{e}:
163	      Fail{e}
164	
165	def arr.r(+r: Result<&2, &2, String, J.Json>) -> Result<&2, &2, String, J.Json>:
166	  match r:
167	    case Done{items}:
168	      Done{J.JArr{items}}
169	    case Fail{e}:
170	      Fail{e}
171	
172	def cons.r(+h: Result<&2, &2, String, J.Json>, +t: Result<&2, &2, String, J.Json>) -> Result<&2, &2, String, J.Json>:
173	  match h t:
174	    case Done{x} Done{y}:
175	      Done{J.JCons{x, y}}
176	    case Fail{e} _:
177	      Fail{e}
178	    case _ Fail{e}:
179	      Fail{e}
180	
181	def nil() -> Result<&2, &2, String, J.Json>:
182	  Done{J.JNil{}}
183	
184	# `acc` is the object under construction while walking a field chain, and
185	# Done{JNil} while walking an array's elements.
186	def ex(+j: J.Json, +acc: Result<&2, &2, String, J.Json>, +strict: Bool) -> Result<&2, &2, String, J.Json>:
187	  match j:
188	    case J.JObj{fs}:
189	      ex(fs, init(), strict)
190	    case J.JField{k, v, t}:
191	      ex(t, fl.r(ex(v, init(), strict), segs_of(k), acc, strict), strict)
192	    case J.JNil{}:
193	      acc
194	    case J.JArr{items}:
195	      arr.r(ex(items, nil(), strict))
196	    case J.JCons{h, t}:
197	      cons.r(ex(h, init(), strict), ex(t, nil(), strict))
198	    case _:
199	      Done{j}
200	
201	# Remove the quoted-key markers (path expansion off).
202	def strip(+j: J.Json) -> J.Json:
203	  match j:
204	    case J.JObj{x}:
205	      J.JObj{strip(x)}
206	    case J.JArr{x}:
207	      J.JArr{strip(x)}
208	    case J.JCons{h, t}:
209	      J.JCons{strip(h), strip(t)}
210	    case J.JField{k, v, t}:
211	      J.JField{Hd.unmark(k), strip(v), strip(t)}
212	    case _:
213	      j
214	
215	def expand(+j: J.Json, +strict: Bool) -> Result<&2, &2, String, J.Json>:
216	  ex(j, init(), strict)