feat: Allow serde_json::Value to be marshalled to std.json.Value

README.md

@@ -116,7 +116,7 @@ let parse : String -> Result String Expr =
     let lex x = x <* spaces
 
     let integer =
-        // `do` expression provide a way to write monads in a way similar to procedural code
+        // `do` expression provide a way to write monads in a way similiar to procedural code
         do i = lex (recognize (skip_many1 digit))
         match int.parse i with
         | Ok x -> wrap x

examples/marshalling.rs

@@ -197,7 +197,7 @@ fn marshal_generic() -> Result<()> {
         let either: forall r . Either String r = Left "hello rust!"
 
         // we can pass the generic Either to the Rust function without an issue
-        seq 
+        seq
             match flip either with
             | Left _ -> error "unreachable!"
             | Right val -> io.println ("Right is: " <> val)
@@ -423,6 +423,47 @@ fn marshal_recursive() -> Result<()> {
     Ok(())
 }
 
+fn marshal_json() -> Result<()> {
+    let vm = new_vm();
+
+    let source = r#"
+        let { Eff, ? } = import! std.effect
+        let io @ { ? } = import! std.effect.io
+        let { Lift, run_lift } = import! std.effect.lift
+        let { Error, run_error, ok_or_throw } = import! std.effect.error
+        let { (<|) } = import! std.function
+
+        let { Value } = import! std.json
+        let de @ { Deserialize, ? } = import! std.json.de
+
+        #[derive(Deserialize)]
+        type MyValue = {
+            bool: Bool,
+            string: String,
+        }
+        let consumer value : Value -> Eff [| error : Error String, lift: Lift IO |] () =
+            do my_value = ok_or_throw <| de.run value
+            seq io.println ("bool = " ++ show my_value.bool)
+            io.println ("string = " ++ show my_value.string)
+
+        \value -> run_lift <| run_error <| consumer value
+        "#;
+
+    vm.run_expr::<OpaqueValue<RootedThread, Hole>>("example", "import! std.json")?;
+
+    let (mut consumer, _) = vm.run_expr::<FunctionRef<
+        fn(serde_json::Value) -> IO<std::result::Result<(), String>>,
+    >>("example", source)?;
+    consumer
+        .call(serde_json::json! {{
+            "bool": true,
+            "string": "hello",
+        }})?
+        .into_result()??;
+
+    Ok(())
+}
+
 fn main() {
     env_logger::init();
 
@@ -458,4 +499,9 @@ fn main() {
         eprintln!("{}", err);
         ::std::process::exit(1);
     }
+
+    if let Err(err) = marshal_json() {
+        eprintln!("{}", err);
+        ::std::process::exit(1);
+    }
 }

std/json/de.glu

@@ -247,6 +247,8 @@ let run ?de value : [Deserialize a] -> Value -> Result Error a =
 #[doc(hidden)]
 let insert_string : String -> a -> Map String a -> Map String a = std_map.insert
 
+let bool_deserializer : Deserialize Bool = { deserializer = bool }
+
 let int_deserializer : Deserialize Int = { deserializer = int }
 
 let float_deserializer : Deserialize Float = { deserializer = float }
@@ -297,6 +299,7 @@ let map_deserializer : [Deserialize a] -> Deserialize (Map String a) =
 
     deserializer,
 
+    bool_deserializer,
     int_deserializer,
     string_deserializer,
     float_deserializer,

vm/Cargo.toml

@@ -70,3 +70,7 @@ gluon_parser = { path = "../parser", version = "0.13.1" } # GLUON
 [features]
 serialization = ["serde", "serde_state", "serde_derive", "serde_derive_state", "serde_json", "gluon_base/serialization", "codespan/serialization"]
 test = ["difference", "lalrpop", "lalrpop-util", "regex", "serialization", "gluon_parser"]
+docs_rs = ["serialization"]
+
+[package.metadata.docs.rs]
+features = ["docs_rs"]

vm/src/api/json.rs

@@ -4,9 +4,11 @@ use std::{borrow::Borrow, fmt, result::Result as StdResult};
 
 use crate::base::types::ArcType;
 
-use crate::api::{Getable, OpaqueValue, VmType};
-use crate::thread::{ActiveThread, RootedThread, Thread, ThreadInternal};
-use crate::{ExternModule, Result, Variants};
+use crate::{
+    api::{Getable, OpaqueValue, ValueRef, VmInt, VmType},
+    thread::{ActiveThread, RootedThread, Thread, ThreadInternal},
+    ExternModule, Result, Variants,
+};
 
 use crate::serde::de::{self, DeserializeState, MapAccess, SeqAccess, Visitor};
 
@@ -58,6 +60,89 @@ pub fn load(vm: &Thread) -> Result<ExternModule> {
     )
 }
 
+impl VmType for serde_json::Value {
+    type Type = Self;
+    fn make_type(vm: &Thread) -> ArcType {
+        JsonValue::make_type(vm)
+    }
+}
+
+impl<'vm> crate::api::Pushable<'vm> for serde_json::Value {
+    fn push(self, context: &mut ActiveThread<'vm>) -> Result<()> {
+        use serde_json::Value::*;
+        let tag = match self {
+            Null => {
+                context.context().push_new_data(0, 0)?;
+                return Ok(());
+            }
+            Bool(b) => {
+                b.push(context)?;
+                1
+            }
+            Number(n) => {
+                if let Some(i) = n.as_i64() {
+                    i.push(context)?;
+                    2
+                } else if let Some(i) = n.as_u64() {
+                    i.push(context)?;
+                    2
+                } else if let Some(i) = n.as_f64() {
+                    i.push(context)?;
+                    3
+                } else {
+                    return Err(format!("Unable to marshal serde_json::Number({})", n).into());
+                }
+            }
+            String(s) => {
+                s.push(context)?;
+                4
+            }
+            Array(a) => {
+                a.push(context)?;
+                5
+            }
+            Object(o) => {
+                crate::api::to_gluon_map(o, context)?;
+                6
+            }
+        };
+        context.context().push_new_data(tag, 1)?;
+        Ok(())
+    }
+}
+
+impl<'vm, 'value> crate::api::Getable<'vm, 'value> for serde_json::Value {
+    impl_getable_simple!();
+
+    fn from_value(vm: &'vm Thread, value: Variants<'value>) -> Self {
+        match value.as_ref() {
+            ValueRef::Data(data) => match data.tag() {
+                0 => serde_json::Value::Null,
+                1 => serde_json::Value::Bool(bool::from_value(vm, data.get_variant(0).unwrap())),
+                2 => serde_json::Value::Number(
+                    VmInt::from_value(vm, data.get_variant(0).unwrap()).into(),
+                ),
+                3 => serde_json::Value::Number(
+                    serde_json::Number::from_f64(f64::from_value(vm, data.get_variant(0).unwrap()))
+                        .unwrap(),
+                ),
+                4 => {
+                    serde_json::Value::String(String::from_value(vm, data.get_variant(0).unwrap()))
+                }
+                5 => serde_json::Value::Array(Vec::from_value(vm, data.get_variant(0).unwrap())),
+                6 => {
+                    let mut map = Default::default();
+                    let inner = data.get_variant(0).unwrap();
+                    crate::api::from_gluon_map(&mut map, vm, inner);
+                    serde_json::Value::Object(map)
+                }
+                _ => ice!("ValueRef has a wrong tag: {}", data.tag()),
+            },
+            _ => ice!("ValueRef is not a std.json.Value"),
+        }
+    }
+}
+
 #[derive(Pushable, Getable, SerializeState)]
 #[serde(serialize_state = "Thread")]
 #[gluon(gluon_vm)]

vm/src/api/mod.rs

@@ -269,6 +269,12 @@ pub enum IO<T> {
     Exception(String),
 }
 
+impl<T> IO<T> {
+    pub fn into_result(self) -> StdResult<T, String> {
+        self.into()
+    }
+}
+
 impl<T> Into<StdResult<T, String>> for IO<T> {
     fn into(self) -> StdResult<T, String> {
         match self {
@@ -1261,19 +1267,7 @@ where
     V::Type: Sized,
 {
     fn push(self, context: &mut ActiveThread<'vm>) -> Result<()> {
-        let thread = context.thread();
-        type Map<V2> = OpaqueValue<RootedThread, BTreeMap<String, V2>>;
-        let mut map: Map<V> = thread.get_global("std.map.empty")?;
-        let mut insert: OwnedFunction<fn(String, V, Map<V>) -> Map<V>> =
-            thread.get_global("std.json.de.insert_string")?;
-
-        context.drop();
-        for (key, value) in self {
-            map = insert.call(key.borrow().to_string(), value, map)?;
-        }
-        context.restore();
-
-        map.push(context)
+        to_gluon_map(self, context)
     }
 }
 
@@ -1285,38 +1279,61 @@ where
     impl_getable_simple!();
 
     fn from_value(vm: &'vm Thread, value: Variants<'value>) -> Self {
-        fn build_map<'vm2, 'value2, K2, V2>(
-            map: &mut BTreeMap<K2, V2>,
-            vm: &'vm2 Thread,
-            value: Variants<'value2>,
-        ) where
-            K2: Getable<'vm2, 'value2> + Ord,
-            V2: Getable<'vm2, 'value2>,
-        {
-            match value.as_ref() {
-                ValueRef::Data(data) => {
-                    if data.tag() == 1 {
-                        let key = K2::from_value(vm, data.get_variant(0).expect("key"));
-                        let value = V2::from_value(vm, data.get_variant(1).expect("value"));
-                        map.insert(key, value);
-
-                        let left = data.get_variant(2).expect("left");
-                        build_map(map, vm, left);
-
-                        let right = data.get_variant(3).expect("right");
-                        build_map(map, vm, right);
-                    }
-                }
-                _ => ice!("ValueRef is not a Map"),
-            }
-        }
-
         let mut map = BTreeMap::new();
-        build_map(&mut map, vm, value);
+        from_gluon_map(&mut map, vm, value);
         map
     }
 }
 
+fn to_gluon_map<'vm, K, V>(
+    map_iter: impl IntoIterator<Item = (K, V)>,
+    context: &mut ActiveThread<'vm>,
+) -> Result<()>
+where
+    K: Borrow<str> + VmType,
+    K::Type: Sized,
+    V: for<'vm2> Pushable<'vm2> + VmType,
+    V::Type: Sized,
+{
+    let thread = context.thread();
+    type Map<V2> = OpaqueValue<RootedThread, BTreeMap<String, V2>>;
+    let mut map: Map<V> = thread.get_global("std.map.empty")?;
+    let mut insert: OwnedFunction<fn(String, V, Map<V>) -> Map<V>> =
+        thread.get_global("std.json.de.insert_string")?;
+
+    context.drop();
+    for (key, value) in map_iter {
+        map = insert.call(key.borrow().to_string(), value, map)?;
+    }
+    context.restore();
+
+    map.push(context)
+}
+
+fn from_gluon_map<'vm2, 'value2, M, K2, V2>(map: &mut M, vm: &'vm2 Thread, value: Variants<'value2>)
+where
+    M: Extend<(K2, V2)>,
+    K2: Getable<'vm2, 'value2> + Ord,
+    V2: Getable<'vm2, 'value2>,
+{
+    match value.as_ref() {
+        ValueRef::Data(data) => {
+            if data.tag() == 1 {
+                let key = K2::from_value(vm, data.get_variant(0).expect("key"));
+                let value = V2::from_value(vm, data.get_variant(1).expect("value"));
+                map.extend(Some((key, value)));
+
+                let left = data.get_variant(2).expect("left");
+                from_gluon_map(map, vm, left);
+
+                let right = data.get_variant(3).expect("right");
+                from_gluon_map(map, vm, right);
+            }
+        }
+        _ => ice!("ValueRef is not a Map"),
+    }
+}
+
 impl<T: VmType> VmType for Option<T>
 where
     T::Type: Sized,