Add from-json interface and to-json for Map/Maybe

json.carp

@@ -777,3 +777,115 @@ automatically boxed.")
   (defn to-json [arr]
     (JSON.Arr (Array.copy-map &(fn [x] (Box.init (to-json @x))) &arr)))
   (implements to-json Array.to-json))
+
+(defmodule Map
+  (defn to-json [m]
+    (JSON.Obj
+      (Map.kv-reduce
+        &(fn [acc k v] (let [bx (Box.init (to-json @v))] (Map.put acc k &bx)))
+        (the (Map String (Box JSON)) {})
+        &m)))
+  (implements to-json Map.to-json))
+
+(defmodule Maybe
+  (defn to-json [m]
+    (match m (Maybe.Nothing) (JSON.Null) (Maybe.Just x) (to-json x)))
+  (implements to-json Maybe.to-json))
+
+; ===========================================================================
+; from-json interface
+; ===========================================================================
+
+(doc from-json "converts a JSON value to a Carp value.
+
+Returns a `(Result a String)` — a `Success` with the extracted value, or an
+`Error` with a message describing the type mismatch.")
+(definterface from-json (Fn [(Ref JSON)] (Result a String)))
+
+(defmodule Bool
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Bool b) (Result.Success @b)
+      _ (Result.Error @"expected Bool")))
+  (implements from-json Bool.from-json))
+
+(defmodule Int
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Num n) (Result.Success (Double.to-int @n))
+      _ (Result.Error @"expected Num")))
+  (implements from-json Int.from-json))
+
+(defmodule Long
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Num n) (Result.Success (Double.to-long @n))
+      _ (Result.Error @"expected Num")))
+  (implements from-json Long.from-json))
+
+(defmodule Float
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Num n) (Result.Success (Double.to-float @n))
+      _ (Result.Error @"expected Num")))
+  (implements from-json Float.from-json))
+
+(defmodule Double
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Num n) (Result.Success @n)
+      _ (Result.Error @"expected Num")))
+  (implements from-json Double.from-json))
+
+(defmodule String
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Str s) (Result.Success @s)
+      _ (Result.Error @"expected Str")))
+  (implements from-json String.from-json))
+
+(defmodule Array
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Arr a)
+        (Array.reduce
+          &(fn [acc bx]
+            (match acc
+              (Result.Error e) (Result.Error e)
+              (Result.Success out)
+                (match (from-json (Box.peek bx))
+                  (Result.Success val)
+                    (Result.Success (Array.push-back out val))
+                  (Result.Error e) (Result.Error e))))
+          (Result.Success [])
+          a)
+      _ (Result.Error @"expected Arr")))
+  (implements from-json Array.from-json))
+
+(defmodule Map
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Obj m)
+        (Map.kv-reduce
+          &(fn [acc k v]
+            (match acc
+              (Result.Error e) (Result.Error e)
+              (Result.Success out)
+                (match (from-json (Box.peek v))
+                  (Result.Success val)
+                    (let [_ 0] (Result.Success (Map.put out k &val)))
+                  (Result.Error e) (Result.Error e))))
+          (Result.Success {})
+          m)
+      _ (Result.Error @"expected Obj")))
+  (implements from-json Map.from-json))
+
+(defmodule Maybe
+  (defn from-json [j]
+    (match-ref j
+      (JSON.Null) (Result.Success (Maybe.Nothing))
+      _
+        (match (from-json j)
+          (Result.Success v) (Result.Success (Maybe.Just v))
+          (Result.Error e) (Result.Error e))))
+  (implements from-json Maybe.from-json))

test/json.carp

@@ -752,6 +752,184 @@ break")) "str string with newline")
     &(ser &(to-json [[1 2] [3 4]]))
     "to-json on nested Array")
 
+  (assert-true test
+    (let [m (Map.from-array [(Pair.init @"x" 1) (Pair.init @"y" 2)])
+          j (to-json m)]
+      (and (JSON.obj? &j)
+           (match (JSON.get &j "x") (Maybe.Just v) (= &(ser &v) "1") _ false)))
+    "to-json on Map")
+
+  (assert-equal test
+    "null"
+    &(ser &(to-json (the (Maybe Int) (Maybe.Nothing))))
+    "to-json on Maybe Nothing")
+
+  (assert-equal test
+    "42"
+    &(ser &(to-json (Maybe.Just 42)))
+    "to-json on Maybe Just")
+
+  ; =========================================================================
+  ; from-json interface
+  ; =========================================================================
+
+  ; Bool
+
+  (assert-true test
+    (match (Bool.from-json &(JSON.Bool true)) (Result.Success b) b _ false)
+    "from-json on Bool true")
+
+  (assert-true test
+    (match (Bool.from-json &(JSON.Bool false))
+      (Result.Success b) (not b)
+      _ false)
+    "from-json on Bool false")
+
+  (assert-true test
+    (Result.error? &(Bool.from-json &(JSON.Null)))
+    "from-json on Bool type mismatch")
+
+  ; Int
+
+  (assert-true test
+    (match (Int.from-json &(JSON.Num 42.0)) (Result.Success n) (= n 42) _ false)
+    "from-json on Int")
+
+  (assert-true test
+    (match (Int.from-json &(JSON.Num 3.7)) (Result.Success n) (= n 3) _ false)
+    "from-json on Int truncates")
+
+  (assert-true test
+    (Result.error? &(Int.from-json &(JSON.Str @"42")))
+    "from-json on Int type mismatch")
+
+  ; Long
+
+  (assert-true test
+    (match (Long.from-json &(JSON.Num 99.0))
+      (Result.Success n) (= n 99l)
+      _ false)
+    "from-json on Long")
+
+  ; Float
+
+  (assert-true test
+    (match (Float.from-json &(JSON.Num 1.5))
+      (Result.Success n) (Float.= n 1.5f)
+      _ false)
+    "from-json on Float")
+
+  ; Double
+
+  (assert-true test
+    (match (Double.from-json &(JSON.Num 3.14))
+      (Result.Success n) (Double.= n 3.14)
+      _ false)
+    "from-json on Double")
+
+  (assert-true test
+    (Result.error? &(Double.from-json &(JSON.Bool true)))
+    "from-json on Double type mismatch")
+
+  ; String
+
+  (assert-true test
+    (match (String.from-json &(JSON.Str @"hello"))
+      (Result.Success s) (= &s "hello")
+      _ false)
+    "from-json on String")
+
+  (assert-true test
+    (Result.error? &(String.from-json &(JSON.Num 1.0)))
+    "from-json on String type mismatch")
+
+  ; Array
+
+  (assert-true test
+    (match (the (Result (Array Int) String)
+                (Array.from-json
+                  &(JSON.Arr
+                    [(Box.init (JSON.Num 1.0))
+                     (Box.init (JSON.Num 2.0))
+                     (Box.init (JSON.Num 3.0))])))
+      (Result.Success arr)
+        (and (= (Array.length &arr) 3) (= @(Array.unsafe-nth &arr 0) 1))
+      _ false)
+    "from-json on Array of Int")
+
+  (assert-true test
+    (Result.error?
+      &(the (Result (Array Int) String)
+            (Array.from-json
+              &(JSON.Arr
+                [(Box.init (JSON.Num 1.0)) (Box.init (JSON.Str @"oops"))]))))
+    "from-json on Array with type mismatch in element")
+
+  (assert-true test
+    (Result.error?
+      &(the (Result (Array Int) String) (Array.from-json &(JSON.Null))))
+    "from-json on Array type mismatch")
+
+  ; Map
+
+  (assert-true test
+    (match (the (Result (Map String Int) String)
+                (Map.from-json
+                  &(JSON.obj
+                    [(JSON.entry @"a" (JSON.Num 1.0))
+                     (JSON.entry @"b" (JSON.Num 2.0))])))
+      (Result.Success m)
+        (and (= (Map.length &m) 2)
+             (match (Map.get-maybe &m "a") (Maybe.Just v) (= v 1) _ false))
+      _ false)
+    "from-json on Map")
+
+  (assert-true test
+    (Result.error?
+      &(the (Result (Map String Int) String) (Map.from-json &(JSON.Null))))
+    "from-json on Map type mismatch")
+
+  ; Maybe
+
+  (assert-true test
+    (match (the (Result (Maybe Int) String) (Maybe.from-json &(JSON.Null)))
+      (Result.Success m) (Maybe.nothing? &m)
+      _ false)
+    "from-json on Maybe Null gives Nothing")
+
+  (assert-true test
+    (match (the (Result (Maybe Int) String) (Maybe.from-json &(JSON.Num 7.0)))
+      (Result.Success m) (match m (Maybe.Just n) (= n 7) _ false)
+      _ false)
+    "from-json on Maybe with value gives Just")
+
+  (assert-true test
+    (Result.error?
+      &(the (Result (Maybe Int) String) (Maybe.from-json &(JSON.Str @"x"))))
+    "from-json on Maybe with wrong type gives Error")
+
+  ; Roundtrip: to-json then from-json
+
+  (assert-true test
+    (match (Int.from-json &(to-json 42)) (Result.Success n) (= n 42) _ false)
+    "roundtrip Int through to-json and from-json")
+
+  (assert-true test
+    (match (String.from-json &(to-json @"hello"))
+      (Result.Success s) (= &s "hello")
+      _ false)
+    "roundtrip String through to-json and from-json")
+
+  (assert-true test
+    (match (Bool.from-json &(to-json true)) (Result.Success b) b _ false)
+    "roundtrip Bool through to-json and from-json")
+
+  (assert-true test
+    (match (the (Result (Array Int) String) (Array.from-json &(to-json [1 2 3])))
+      (Result.Success arr) (= &arr &[1 2 3])
+      _ false)
+    "roundtrip Array Int through to-json and from-json")
+
   ; =========================================================================
   ; Pretty serializer (pretty-str)
   ; =========================================================================