1use std::collections::HashMap;
34use std::sync::Arc;
35
36use serde_json::Value as JsonValue;
37use tatara_lisp_eval::ffi::Arity;
38use tatara_lisp_eval::{EvalError, Interpreter, MapKey, Value};
39
40pub fn install_json_stdlib<H: 'static>(interp: &mut Interpreter<H>) {
42 interp.register_fn(
43 "json_parse",
44 Arity::Exact(1),
45 |args: &[Value], _h: &mut H, span| {
46 let s = as_str(&args[0], "json_parse", span)?;
47 let parsed: JsonValue = serde_json::from_str(&s)
48 .map_err(|e| EvalError::native_fn("json_parse", e.to_string(), span))?;
49 Ok(json_to_value(&parsed))
50 },
51 );
52
53 interp.register_fn(
54 "json_stringify",
55 Arity::Exact(1),
56 |args: &[Value], _h: &mut H, span| {
57 let s = serde_json::to_string(&value_to_json(&args[0]))
58 .map_err(|e| EvalError::native_fn("json_stringify", e.to_string(), span))?;
59 Ok(Value::Str(Arc::from(s)))
60 },
61 );
62
63 interp.register_fn(
64 "json_get",
65 Arity::Exact(2),
66 |args: &[Value], _h: &mut H, span| {
67 let doc = &args[0];
68 let key = as_str(&args[1], "json_get", span)?;
69 match json_lookup(doc, &key) {
70 Some(v) => Ok(v),
71 None if is_doc(doc) => Ok(Value::Nil),
72 None => Err(EvalError::native_fn(
73 "json_get",
74 format!("cannot read a field from a {}", doc.type_name()),
75 span,
76 )),
77 }
78 },
79 );
80
81 interp.register_fn(
82 "json_get_or",
83 Arity::Exact(3),
84 |args: &[Value], _h: &mut H, span| {
85 let doc = &args[0];
86 let key = as_str(&args[1], "json_get_or", span)?;
87 match json_lookup(doc, &key) {
88 Some(v) => Ok(v),
89 None if is_doc(doc) => Ok(args[2].clone()),
90 None => Err(EvalError::native_fn(
91 "json_get_or",
92 format!("cannot read a field from a {}", doc.type_name()),
93 span,
94 )),
95 }
96 },
97 );
98}
99
100fn is_doc(v: &Value) -> bool {
104 matches!(v, Value::List(_) | Value::Map(_))
105}
106
107fn as_str(v: &Value, fname: &'static str, span: tatara_lisp::Span) -> Result<String, EvalError> {
108 match v {
109 Value::Str(s) => Ok(s.to_string()),
110 Value::Symbol(s) | Value::Keyword(s) => Ok(s.to_string()),
113 other => Err(EvalError::type_mismatch("a string", other.type_name(), span)
114 .into_native(fname)),
115 }
116}
117
118trait NameError {
121 fn into_native(self, fname: &'static str) -> EvalError;
122}
123
124impl NameError for EvalError {
125 fn into_native(self, fname: &'static str) -> EvalError {
126 match self {
127 EvalError::TypeMismatch { expected, got, at } => EvalError::native_fn(
128 fname,
129 format!("expected {expected}, got {got}"),
130 at,
131 ),
132 other => other,
133 }
134 }
135}
136
137pub fn json_to_value(j: &JsonValue) -> Value {
141 match j {
142 JsonValue::Null => Value::Nil,
143 JsonValue::Bool(b) => Value::Bool(*b),
144 JsonValue::Number(n) => {
145 if let Some(i) = n.as_i64() {
146 Value::Int(i)
147 } else {
148 Value::Float(n.as_f64().unwrap_or(0.0))
149 }
150 }
151 JsonValue::String(s) => Value::Str(Arc::from(s.as_str())),
152 JsonValue::Array(xs) => Value::List(Arc::new(xs.iter().map(json_to_value).collect())),
153 JsonValue::Object(m) if m.is_empty() => Value::Map(Arc::new(HashMap::new())),
154 JsonValue::Object(m) => Value::List(Arc::new(
155 m.iter()
156 .map(|(k, v)| {
157 Value::List(Arc::new(vec![Value::Str(Arc::from(k.as_str())), json_to_value(v)]))
158 })
159 .collect(),
160 )),
161 }
162}
163
164pub fn value_to_json(v: &Value) -> JsonValue {
167 match v {
168 Value::Nil => JsonValue::Null,
169 Value::Bool(b) => JsonValue::Bool(*b),
170 Value::Int(n) => JsonValue::Number((*n).into()),
171 Value::Float(n) => serde_json::Number::from_f64(*n)
172 .map(JsonValue::Number)
173 .unwrap_or(JsonValue::Null),
174 Value::Str(s) | Value::Symbol(s) | Value::Keyword(s) => {
175 JsonValue::String(s.as_ref().to_owned())
176 }
177 Value::List(xs) => {
182 let looks_like_object = !xs.is_empty()
183 && xs.iter().all(|entry| {
184 if let Value::List(pair) = entry {
185 pair.len() == 2
186 && matches!(pair[0], Value::Str(_) | Value::Symbol(_) | Value::Keyword(_))
187 } else {
188 false
189 }
190 });
191 if looks_like_object {
192 let mut m = serde_json::Map::with_capacity(xs.len());
193 for entry in xs.iter() {
194 if let Value::List(pair) = entry {
195 let k = match &pair[0] {
196 Value::Str(s) | Value::Symbol(s) | Value::Keyword(s) => {
197 s.as_ref().to_owned()
198 }
199 _ => unreachable!(),
200 };
201 m.insert(k, value_to_json(&pair[1]));
202 }
203 }
204 JsonValue::Object(m)
205 } else {
206 JsonValue::Array(xs.iter().map(value_to_json).collect())
207 }
208 }
209 Value::Map(m) => JsonValue::Object(
214 m.iter()
215 .map(|(k, v)| (map_key_to_json_key(k), value_to_json(v)))
216 .collect(),
217 ),
218 _ => JsonValue::Null,
219 }
220}
221
222fn map_key_to_json_key(k: &MapKey) -> String {
223 match k {
224 MapKey::Str(s) | MapKey::Symbol(s) | MapKey::Keyword(s) => s.as_ref().to_owned(),
225 MapKey::Nil => "null".to_owned(),
226 MapKey::Bool(b) => b.to_string(),
227 MapKey::Int(n) => n.to_string(),
228 MapKey::Float(bits) => f64::from_bits(*bits).to_string(),
229 }
230}
231
232fn json_lookup(doc: &Value, key: &str) -> Option<Value> {
235 match doc {
236 Value::List(entries) => entries.iter().find_map(|entry| {
237 let Value::List(pair) = entry else { return None };
238 if pair.len() != 2 {
239 return None;
240 }
241 let matches = match &pair[0] {
242 Value::Str(s) | Value::Symbol(s) | Value::Keyword(s) => s.as_ref() == key,
243 _ => false,
244 };
245 matches.then(|| pair[1].clone())
246 }),
247 Value::Map(m) => {
248 let k = MapKey::Str(Arc::from(key));
249 m.get(&k).cloned()
250 }
251 _ => None,
252 }
253}
254
255#[cfg(test)]
256mod tests {
257 use super::*;
258
259 fn eval(src: &str) -> Value {
260 crate::run(src)
261 .unwrap_or_else(|e| panic!("{src:?}: {e}"))
262 .value
263 }
264
265 fn s(src: &str) -> String {
266 match eval(src) {
267 Value::Str(v) => v.to_string(),
268 other => panic!("{src:?} produced {other:?}"),
269 }
270 }
271
272 fn assert_round_trips(src: &str) {
276 let parsed: JsonValue = serde_json::from_str(src).expect("fixture is valid JSON");
277 let out = value_to_json(&json_to_value(&parsed));
278 assert_eq!(out, parsed, "round-trip changed the document\nin: {src}");
279 }
280
281 #[test]
282 fn parse_and_get_an_object_field() {
283 let v = eval(r#"json_get(json_parse("{\"outcome\":\"ok\"}"), "outcome")"#);
284 assert!(
285 matches!(v, Value::Str(ref x) if &**x == "ok"),
286 "got {v:?}"
287 );
288 }
289
290 #[test]
291 fn a_missing_field_is_nil_not_an_error() {
292 assert!(matches!(
293 eval(r#"json_get(json_parse("{\"a\":1}"), "nope")"#),
294 Value::Nil
295 ));
296 }
297
298 #[test]
299 fn json_get_or_returns_the_default() {
300 assert!(matches!(
301 eval(r#"json_get_or(json_parse("{}"), "nope", 42)"#),
302 Value::Int(42)
303 ));
304 }
305
306 #[test]
307 fn nested_objects_read_by_walking_alists() {
308 let src = r#"json_get(
309 json_get(json_parse("{\"outer\":{\"inner\":7}}"), "outer"),
310 "inner")"#;
311 assert!(matches!(eval(src), Value::Int(7)));
312 }
313
314 #[test]
315 fn numbers_and_bools_keep_their_kinds() {
316 assert!(matches!(
317 eval(r#"json_get(json_parse("{\"n\":1,\"b\":true}"), "n")"#),
318 Value::Int(1)
319 ));
320 assert!(matches!(
321 eval(r#"json_get(json_parse("{\"b\":true}"), "b")"#),
322 Value::Bool(true)
323 ));
324 }
325
326 #[test]
327 fn null_is_nil() {
328 assert!(matches!(
329 eval(r#"json_get(json_parse("{\"x\":null}"), "x")"#),
330 Value::Nil
331 ));
332 }
333
334 #[test]
335 fn stringify_reaches_the_parser_shape_back() {
336 assert_eq!(
337 s(r#"json_stringify(json_parse("{\"a\":1,\"b\":[1,2]}"))"#),
338 r#"{"a":1,"b":[1,2]}"#
339 );
340 }
341
342 #[test]
343 fn empty_object_round_trips() {
344 assert_round_trips("{}");
345 assert_round_trips(r#"{"a":{}}"#);
346 assert_round_trips(r#"{"a":{"b":{}}}"#);
347 assert_round_trips(r#"[{},{}]"#);
348 }
349
350 #[test]
351 fn empty_array_is_not_confused_for_an_object() {
352 assert_round_trips("[]");
353 assert_round_trips(r#"{"a":[]}"#);
354 assert_round_trips(r#"{"obj":{},"arr":[]}"#);
355 }
356
357 #[test]
358 fn non_empty_objects_parse_to_alists() {
359 let v = eval(r#"json_parse("{\"a\":1}")"#);
360 assert!(matches!(v, Value::List(_)), "non-empty object must be an alist");
361 }
362
363 #[test]
364 fn a_parsed_empty_object_is_a_map_and_reads_as_nil() {
365 let v = eval(r#"json_parse("{}")"#);
366 assert!(matches!(v, Value::Map(_)), "an empty object must be a Map so it round-trips");
367 assert!(
368 matches!(
369 eval(r#"json_get(json_parse("{}"), "anything")"#),
370 Value::Nil
371 ),
372 "an empty object has no fields to read"
373 );
374 }
375
376 #[test]
377 fn unparseable_json_is_a_named_error() {
378 let err = crate::run(r#"json_parse("{not json")"#).expect_err("must raise");
379 assert!(
380 err.to_string().contains("json_parse"),
381 "the error must name the primitive: {err}"
382 );
383 }
384
385 #[test]
386 fn a_wrong_typed_argument_is_a_type_error() {
387 assert!(crate::run(r#"json_parse(42)"#).is_err());
388 assert!(crate::run(r#"json_get("not a doc", "k")"#).is_err());
389 }
390}