1	import Base
2	import ../json.bend as Json
3	import ./ylex.bend as L
4	import ./yscal.bend as S
5	
6	# The YAML reader: the block subset cswap writes plus plain block maps, block
7	# sequences and scalars. Supported: `key: value`, `key:` with an indented
8	# block (or a `- ` sequence at the key's own indent), `- item`, `- key: v`
9	# (a mapping that starts on the dash line), `[]`, `{}`, flat flow `[a, b]` and
10	# `{a: 1}`, plain / 'single' / "double" quoted scalars (JSON escapes), comments,
11	# a leading `---`. Not supported (a clear error): tabs for indentation,
12	# anchors/aliases/tags, block scalars (| >), multi-line scalars, several
13	# documents.
14	#
15	# The structure is found without mutual recursion: lines are split into the
16	# entries of a block (by indent), and one fuel-bounded `val` walks plans.
17	
18	type Ln is Data:
19	  Ln{ind: Nat, text: String}
20	
21	# What `val` does next.
22	type Plan is Data:
23	  PRes{r: Result<&2, &2, String, Json.Json>}
24	  PBlk{ls: List<&2, Ln>}
25	  PArr{es: List<&2, List<&2, Ln>>}
26	  PObj{es: List<&2, List<&2, Ln>>}
27	  PItems{b: List<&2, Ln>, r: List<&2, List<&2, Ln>>}
28	  PFieldI{k: String, v: Result<&2, &2, String, Json.Json>, r: List<&2, List<&2, Ln>>}
29	  PFieldB{k: String, b: List<&2, Ln>, r: List<&2, List<&2, Ln>>}
30	
31	# ---- lines -------------------------------------------------------------------------
32	
33	# Leading spaces; a tab in the indentation is an error (-1 is not a Nat, so
34	# the flag travels beside).
35	def lead.count(s: String, +n: Nat) -> Nat:
36	  match s:
37	    case SCon{Chr{c}, t}:
38	      Bool.pick(Nat, U32.is_eq(c, 32), lead.count(t, Nat.add(n, 1n)), n)
39	    case SNil{}:
40	      n
41	
42	def tab_lead(s: String) -> Bool:
43	  match s:
44	    case SCon{Chr{+c}, t}:
45	      Bool.pick(Bool, U32.is_eq(c, 32), tab_lead(t), U32.is_eq(c, 9))
46	    case SNil{}:
47	      False{}
48	
49	def is_comment(+t: String) -> Bool:
50	  String.is_empty(t) || U32.is_eq(S.first_code(t), 35)
51	
52	type Acc is Data:
53	  Acc{ls: List<&2, Ln>, seen: Bool, err: String}
54	
55	def acc.add(+a: Acc, +raw: String) -> Acc:
56	  match a:
57	    case Acc{ls, seen, err}:
58	      Acc{Ln{lead.count(raw, 0n), String.trim_start(raw)} <> ls, True{}, err}
59	
60	def acc.fail(+a: Acc, msg: String) -> Acc:
61	  match a:
62	    case Acc{ls, seen, err}:
63	      Acc{ls, seen, Bool.pick(String, String.is_empty(err), msg, err)}
64	
65	def acc.skip(+a: Acc) -> Acc:
66	  a
67	
68	def acc.marker(+a: Acc, +seen: Bool) -> Acc:
69	  Bool.pick(Acc, seen, acc.fail(a, "several documents are not supported"), a)
70	
71	def acc.seen(+a: Acc) -> Bool:
72	  match a:
73	    case Acc{ls, seen, err}:
74	      seen
75	
76	def acc.line2(blank: Bool, marker: Bool, tab: Bool, +a: Acc, +raw: String) -> Acc:
77	  match blank marker tab:
78	    case True{} _ _:
79	      a
80	    case False{} True{} _:
81	      acc.marker(a, acc.seen(a))
82	    case False{} False{} True{}:
83	      acc.fail(a, "tabs are not allowed for indentation")
84	    case False{} False{} False{}:
85	      acc.add(a, raw)
86	
87	def acc.line(+a: Acc, +raw: String) -> Acc:
88	  acc.line2(is_comment(String.trim_start(raw)), String.eq(String.trim_end(raw), "---"), tab_lead(raw), a, String.trim_end(raw))
89	
90	def acc.go(rs: List<&2, String>, +a: Acc) -> Acc:
91	  match rs:
92	    case Nil{}:
93	      a
94	    case Con{r, t}:
95	      acc.go(t, acc.line(a, r))
96	
97	def lines.fin(+a: Acc) -> Result<&2, &2, String, List<&2, Ln>>:
98	  match a:
99	    case Acc{ls, seen, err}:
100	      Bool.pick(Result<&2, &2, String, List<&2, Ln>>, String.is_empty(err), Done{List.reverse(&2, Ln, ls)}, Fail{err})
101	
102	def lines_of(+text: String) -> Result<&2, &2, String, List<&2, Ln>>:
103	  lines.fin(acc.go(String.split(text, '\n'), Acc{[], False{}, ""}))
104	
105	# ---- splitting a block into entries ---------------------------------------------------
106	
107	def all_ge(ls: List<&2, Ln>, +n: Nat) -> Bool:
108	  match ls:
109	    case Nil{}:
110	      True{}
111	    case Con{Ln{i, t}, r}:
112	      Nat.is_ge(i, n) && all_ge(r, n)
113	
114	def is_dash(+t: String) -> Bool:
115	  String.eq(t, "-") || String.starts_with(t, "- ")
116	
117	def key_empty.of(kv: S.KV) -> Bool:
118	  match kv:
119	    case S.KOk{k, rest}:
120	      String.is_empty(rest)
121	    case _:
122	      False{}
123	
124	def key_empty(+t: String) -> Bool:
125	  key_empty.of(S.split_kv(t))
126	
127	type Sp is Data:
128	  Sp{done: List<&2, List<&2, Ln>>, cur: List<&2, Ln>, hold: Bool}
129	
130	def sp.start(+sp: Sp, +l: Ln, hold: Bool) -> Sp:
131	  match sp:
132	    case Sp{done, cur, h}:
133	      Sp{Bool.pick(List<&2, List<&2, Ln>>, List.is_empty(&2, Ln, cur), done, List.reverse(&2, Ln, cur) <> done), [l], hold}
134	
135	def sp.more(+sp: Sp, +l: Ln) -> Sp:
136	  match sp:
137	    case Sp{done, cur, h}:
138	      Sp{done, l <> cur, h}
139	
140	def sp.hold(+sp: Sp) -> Bool:
141	  match sp:
142	    case Sp{done, cur, h}:
143	      h
144	
145	# A line at the block's indent opens an entry, except a `- ` line right under
146	# an empty `key:` of a mapping (the sequence PyYAML writes at the key's indent).
147	def sp.step2(new: Bool, +sp: Sp, +l: Ln, +t: String) -> Sp:
148	  match new:
149	    case True{}:
150	      sp.start(sp, l, key_empty(t))
151	    case False{}:
152	      sp.more(sp, l)
153	
154	def sp.step(+n: Nat, +map: Bool, +sp: Sp, +l: Ln) -> Sp:
155	  match l:
156	    case Ln{i, t}:
157	      sp.step2(Nat.is_eq(i, n) && Bool.not(map && sp.hold(sp) && is_dash(t)), sp, Ln{i, t}, t)
158	
159	def sp.go(ls: List<&2, Ln>, +n: Nat, +map: Bool, +sp: Sp) -> Sp:
160	  match ls:
161	    case Nil{}:
162	      sp
163	    case Con{l, t}:
164	      sp.go(t, n, map, sp.step(n, map, sp, l))
165	
166	def sp.fin(+sp: Sp) -> List<&2, List<&2, Ln>>:
167	  match sp:
168	    case Sp{done, cur, h}:
169	      List.reverse(&2, List<&2, Ln>, Bool.pick(List<&2, List<&2, Ln>>, List.is_empty(&2, Ln, cur), done, List.reverse(&2, Ln, cur) <> done))
170	
171	def split(ls: List<&2, Ln>, +n: Nat, +map: Bool) -> List<&2, List<&2, Ln>>:
172	  sp.fin(sp.go(ls, n, map, Sp{[], [], False{}}))
173	
174	# ---- plans ---------------------------------------------------------------------------
175	
176	def bad(msg: String) -> Plan:
177	  PRes{Fail{msg}}
178	
179	def item.text(+t: String) -> String:
180	  Bool.pick(String, String.eq(t, "-"), "", String.trim_start(String.drop(t, 1n)))
181	
182	def item.rest(+r: String) -> String:
183	  Bool.pick(String, String.is_empty(S.uncomment(r)), "", r)
184	
185	def item.block(+n: Nat, +t: String, +rest: String, +body: List<&2, Ln>) -> List<&2, Ln>:
186	  Bool.pick(List<&2, Ln>, String.is_empty(rest), body, Ln{Nat.add(n, Nat.sub(String.length(t), String.length(rest))), rest} <> body)
187	
188	def items.head(dash: Bool, +n: Nat, +t: String, body: List<&2, Ln>, r: List<&2, List<&2, Ln>>) -> Plan:
189	  match dash:
190	    case True{}:
191	      PItems{item.block(n, t, item.rest(item.text(t)), body), r}
192	    case False{}:
193	      bad("expected '- ' to start a sequence item")
194	
195	def plan.items(es: List<&2, List<&2, Ln>>) -> Plan:
196	  match es:
197	    case Nil{}:
198	      PRes{Done{Json.JNil{}}}
199	    case Con{Con{Ln{n, +t}, body}, r}:
200	      items.head(is_dash(t), n, t, body, r)
201	    case Con{Nil{}, r}:
202	      bad("empty sequence entry")
203	
204	def field.extra(v: Result<&2, &2, String, Json.Json>, +k: String) -> Plan:
205	  match v:
206	    case Fail{e}:
207	      bad(e)
208	    case Done{x}:
209	      bad("unexpected indented lines after the value of '" ++ k ++ "'")
210	
211	def field.both(no_body: Bool, +k: String, +rest: String, r: List<&2, List<&2, Ln>>) -> Plan:
212	  match no_body:
213	    case True{}:
214	      PFieldI{k, S.scalar(rest), r}
215	    case False{}:
216	      field.extra(S.scalar(rest), k)
217	
218	def field.inline(empty: Bool, +k: String, +rest: String, body: List<&2, Ln>, r: List<&2, List<&2, Ln>>) -> Plan:
219	  match empty:
220	    case True{}:
221	      PFieldB{k, body, r}
222	    case False{}:
223	      field.both(List.is_empty(&2, Ln, body), k, rest, r)
224	
225	def field.kv(kv: S.KV, body: List<&2, Ln>, r: List<&2, List<&2, Ln>>) -> Plan:
226	  match kv:
227	    case S.KOk{k, +rest}:
228	      field.inline(String.is_empty(S.uncomment(rest)), k, rest, body, r)
229	    case S.KBad{m}:
230	      bad(m)
231	    case S.KNone{}:
232	      bad("expected 'key: value'")
233	
234	def plan.fields(es: List<&2, List<&2, Ln>>) -> Plan:
235	  match es:
236	    case Nil{}:
237	      PRes{Done{Json.JNil{}}}
238	    case Con{Con{Ln{n, t}, body}, r}:
239	      field.kv(S.split_kv(t), body, r)
240	    case Con{Nil{}, r}:
241	      bad("empty mapping entry")
242	
243	type BKind is Data:
244	  KSeq{}
245	  KMap{}
246	  KScalar{}
247	
248	def kind.of2(dash: Bool, kv: S.KV) -> BKind:
249	  match dash kv:
250	    case True{} _:
251	      KSeq{}
252	    case False{} S.KNone{}:
253	      KScalar{}
254	    case False{} _:
255	      KMap{}
256	
257	def kind.of(+t: String) -> BKind:
258	  kind.of2(is_dash(t), S.split_kv(t))
259	
260	def blk.scalar(single: Bool, +t: String) -> Plan:
261	  match single:
262	    case True{}:
263	      PRes{S.scalar(t)}
264	    case False{}:
265	      bad("unexpected indentation")
266	
267	def blk.kind(k: BKind, +n: Nat, +t: String, ls: List<&2, Ln>, +all: List<&2, Ln>) -> Plan:
268	  match k:
269	    case KSeq{}:
270	      PArr{split(all, n, False{})}
271	    case KMap{}:
272	      PObj{split(all, n, True{})}
273	    case KScalar{}:
274	      blk.scalar(List.is_empty(&2, Ln, ls), t)
275	
276	def blk.fit(ok: Bool, +n: Nat, +t: String, ls: List<&2, Ln>, +all: List<&2, Ln>) -> Plan:
277	  match ok:
278	    case True{}:
279	      blk.kind(kind.of(t), n, t, ls, all)
280	    case False{}:
281	      bad("inconsistent indentation")
282	
283	def plan.blk(+ls: List<&2, Ln>) -> Plan:
284	  match ls:
285	    case Nil{}:
286	      PRes{Done{Json.JNull{}}}
287	    case Con{Ln{n, t}, rest}:
288	      blk.fit(all_ge(rest, n), n, t, rest, Con{Ln{n, t}, rest})
289	
290	# ---- the walk --------------------------------------------------------------------------
291	
292	def item.cons(x: Result<&2, &2, String, Json.Json>, rest: Result<&2, &2, String, Json.Json>) -> Result<&2, &2, String, Json.Json>:
293	  S.item.cons(x, rest)
294	
295	def val(fuel: Nat, pl: Plan) -> Result<&2, &2, String, Json.Json>:
296	  match fuel pl:
297	    case 0n _:
298	      Fail{"nesting too deep"}
299	    case 1n++p PRes{r}:
300	      r
301	    case 1n++p PBlk{ls}:
302	      val(p, plan.blk(ls))
303	    case 1n++p PArr{es}:
304	      S.wrap.arr(val(p, plan.items(es)))
305	    case 1n++p PObj{es}:
306	      S.wrap.obj(val(p, plan.fields(es)))
307	    case 1n++p PItems{b, r}:
308	      item.cons(val(p, PBlk{b}), val(p, plan.items(r)))
309	    case 1n++p PFieldI{k, v, r}:
310	      S.field.cons(k, v, val(p, plan.fields(r)))
311	    case 1n++p PFieldB{k, b, r}:
312	      S.field.cons(k, val(p, PBlk{b}), val(p, plan.fields(r)))
313	
314	def parse.run(ls: List<&2, Ln>, +fuel: Nat) -> Result<&2, &2, String, Json.Json>:
315	  val(fuel, PBlk{ls})
316	
317	def parse.lines(r: Result<&2, &2, String, List<&2, Ln>>) -> Result<&2, &2, String, Json.Json>:
318	  match r:
319	    case Fail{e}:
320	      Fail{e}
321	    case Done{+ls}:
322	      parse.run(ls, Nat.add(Nat.mul(4n, List.length(&2, Ln, ls)), 8n))
323	
324	# The value of a YAML document in the supported subset; `Fail` says what is not.
325	def parse(+text: String) -> Result<&2, &2, String, Json.Json>:
326	  parse.lines(lines_of(text))