Actually works now?
parent
5a31d63c3f
commit
cf666a0d05
@ -1,3 +1,5 @@
|
|||||||
(melange.emit
|
(melange.emit
|
||||||
(target main)
|
(target main)
|
||||||
|
(preprocess
|
||||||
|
(pps melange.ppx))
|
||||||
(libraries hcfg))
|
(libraries hcfg))
|
||||||
|
@ -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 parse str =
|
||||||
let rec hvalue_to_js x = match x with
|
let _hvalue_to_js = [%mel.raw {|
|
||||||
| Hcfg.Parser.STRING s -> Js.Json.string s
|
function _hvalue_to_js(hvalue) {
|
||||||
| Hcfg.Parser.INTEGER i -> Js.Json.number (float_of_int i)
|
switch (hvalue.TAG) {
|
||||||
| Hcfg.Parser.FLOAT f -> Js.Json.number f
|
case 0:
|
||||||
| Hcfg.Parser.BINARY _ -> failwith "Binary not supported"
|
// Number
|
||||||
| Hcfg.Parser.NULL -> Js.Json.null
|
case 1:
|
||||||
| Hcfg.Parser.ARRAY a -> Js.Json.array (Array.of_list (List.map hvalue_to_js a))
|
// String
|
||||||
| 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
|
case 2:
|
||||||
Hcfg.Lexer.generate_tokens str |> Hcfg.Parser.parse |> hvalue_to_js
|
// 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
|
Loading…
Reference in New Issue