diff --git a/jslib/dune b/jslib/dune index e30e334..c25c948 100644 --- a/jslib/dune +++ b/jslib/dune @@ -1,3 +1,5 @@ (melange.emit (target main) + (preprocess + (pps melange.ppx)) (libraries hcfg)) diff --git a/jslib/main.ml b/jslib/main.ml index 85579bd..074be63 100644 --- a/jslib/main.ml +++ b/jslib/main.ml @@ -1,10 +1,46 @@ +type bytearray +external create_bytearray: Bytes.t -> bytearray = "Uint8Array" [@@mel.new] + +module JsValue = struct + type jsvalue = + | NUMBER of Js.Float.t + | STRING of Js.String.t + | BINARY of bytearray + | NULL of unit Js.Nullable.t + | ARRAY of jsvalue Js.Array.t + | OBJECT of jsvalue Js.Dict.t +end + let parse str = - let rec hvalue_to_js x = match x with - | Hcfg.Parser.STRING s -> Js.Json.string s - | Hcfg.Parser.INTEGER i -> Js.Json.number (float_of_int i) - | Hcfg.Parser.FLOAT f -> Js.Json.number f - | Hcfg.Parser.BINARY _ -> failwith "Binary not supported" - | Hcfg.Parser.NULL -> Js.Json.null - | Hcfg.Parser.ARRAY a -> Js.Json.array (Array.of_list (List.map hvalue_to_js a)) - | Hcfg.Parser.OBJECT o -> Js.Json.object_ (Js.Dict.fromList (List.map (fun (k, v) -> (k, hvalue_to_js v)) (Hcfg.Parser.Obj.to_list o))) in - Hcfg.Lexer.generate_tokens str |> Hcfg.Parser.parse |> hvalue_to_js \ No newline at end of file + let _hvalue_to_js = [%mel.raw {| + function _hvalue_to_js(hvalue) { + switch (hvalue.TAG) { + case 0: + // Number + case 1: + // String + case 2: + // Binary + case 3: + // Null + return hvalue._0 + case 4: + return hvalue._0.map(_hvalue_to_js) + // Array + case 5: + // Obj + return Object.fromEntries( + Object.entries(hvalue._0).map(([k, v]) => [k, _hvalue_to_js(v)]) + ) + } + } + |}] in + let rec hvalue_to_js = function + | Hcfg.Parser.STRING s -> JsValue.STRING s + | Hcfg.Parser.INTEGER i -> JsValue.NUMBER (float_of_int i) + | Hcfg.Parser.FLOAT f -> JsValue.NUMBER f + | Hcfg.Parser.BINARY b -> JsValue.BINARY (create_bytearray b) + | Hcfg.Parser.NULL -> JsValue.NULL (Js.Nullable.null) + | Hcfg.Parser.ARRAY a -> JsValue.ARRAY (Array.of_list (List.map hvalue_to_js a)) + | Hcfg.Parser.OBJECT o -> JsValue.OBJECT (Js.Dict.fromList (List.map (fun (k, v) -> (k, hvalue_to_js v)) (Hcfg.Parser.Obj.to_list o))) in + Hcfg.Lexer.generate_tokens str |> Hcfg.Parser.parse |> hvalue_to_js |> _hvalue_to_js \ No newline at end of file diff --git a/lib/parser.ml b/lib/parser.ml index 339483e..faa96ea 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -68,6 +68,7 @@ module Parser = struct | (OBJECT a, OBJECT b) -> Obj.equal equal a b | _ -> false + let stringify_bytes b = Bytes.fold_left (fun acc b -> acc ^ Printf.sprintf "\\x%2x" (Char.code b)) "" b let rec hvalue_to_string = function | INTEGER a -> "INTEGER: " ^ Int.to_string a diff --git a/test/test.hcfg b/test/test.hcfg index d068828..39b0284 100644 --- a/test/test.hcfg +++ b/test/test.hcfg @@ -3,6 +3,7 @@ key: "value", /* this is a comment */ other_key: 100, + nulled: null, floating: 123f, other_float: 123.3, bin: b"test",