diff --git a/contrib/kaitai-ocaml/src/parse.ml b/contrib/kaitai-ocaml/src/parse.ml index 32d3d7793e60697bdde6a27e8d3e753d1e34c722..5eb7f4786cf4e05004bee64ecb97545bc8851e34 100644 --- a/contrib/kaitai-ocaml/src/parse.ml +++ b/contrib/kaitai-ocaml/src/parse.ml @@ -144,8 +144,13 @@ let parse ?file ?(path = []) s = | Some e -> Some (ValidationSpec.ValidationExpr (expression e)) in + let enum = + match find_key_opt m "enum" with + | None -> None + | Some e -> Some (scalar e) + in AttrSpec. - {path = []; id; dataType; cond; valid; doc = empty_doc}) + {path = []; id; dataType; cond; valid; doc = empty_doc; enum}) in let doc = empty_doc in diff --git a/contrib/kaitai-ocaml/src/print.ml b/contrib/kaitai-ocaml/src/print.ml index 0b35df9be074d27292e584bb5cf2567a0de07896..b0f2759f26fa57e6b1aed628207744b4729273d8 100644 --- a/contrib/kaitai-ocaml/src/print.ml +++ b/contrib/kaitai-ocaml/src/print.ml @@ -60,7 +60,11 @@ let classSpec _ = mapping [("test", scalar "test")] let instanceSpec _ = mapping [("test", scalar "test")] -let enumSpec _ = mapping [("test", scalar "test")] +let enumSpec enumspec = + mapping + (List.map + (fun (v, EnumValueSpec.{name; _}) -> (string_of_int v, scalar name)) + enumspec.EnumSpec.map) let if_not_empty = function [] -> false | _ -> true @@ -87,15 +91,19 @@ let to_yaml (t : ClassSpec.t) = |> List.map (fun v -> mapping (("id", scalar v.AttrSpec.id) - :: - (* We only add "type" to Yaml if not [AnyType]. - TODO: This is only correct if [AnyType] means no type? *) - (if v.AttrSpec.dataType = AnyType then [] - else - [ - ( "type", - scalar (DataType.to_string v.AttrSpec.dataType) ); - ])))) ); + :: + (* We only add "type" to Yaml if not [AnyType]. + TODO: This is only correct if [AnyType] means no type? *) + (if v.AttrSpec.dataType = AnyType then [] + else + [ + ( "type", + scalar (DataType.to_string v.AttrSpec.dataType) ); + ]) + @ + match v.AttrSpec.enum with + | None -> [] + | Some enum -> [("enum", scalar enum)]))) ); ]) let print t = diff --git a/contrib/kaitai-ocaml/src/types.ml b/contrib/kaitai-ocaml/src/types.ml index cf7c8821ccc105494a4766ccef21eafec5e03d04..36f85100330e47544ebdc50118c14dc1bec84015 100644 --- a/contrib/kaitai-ocaml/src/types.ml +++ b/contrib/kaitai-ocaml/src/types.ml @@ -229,6 +229,7 @@ module AttrSpec = struct dataType : DataType.t; cond : ConditionalSpec.t; valid : ValidationSpec.t option; + enum : string option; doc : DocSpec.t; } end diff --git a/contrib/lib_kaitai_of_data_encoding/ground.ml b/contrib/lib_kaitai_of_data_encoding/ground.ml new file mode 100644 index 0000000000000000000000000000000000000000..7a5a63f9273dbb33c2616d4677a7e03cdb72c449 --- /dev/null +++ b/contrib/lib_kaitai_of_data_encoding/ground.ml @@ -0,0 +1,88 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Marigold, *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Kaitai.Types + +let default_doc_spec = DocSpec.{summary = None; refs = []} + +let cond_no_cond = + AttrSpec.ConditionalSpec.{ifExpr = None; repeat = RepeatSpec.NoRepeat} + +module Enum = struct + type map = (string * Kaitai.Types.EnumSpec.t) list + + let add enums ((k, e) as enum) = + let rec add = function + | [] -> enum :: enums + | ee :: _ when enum = ee -> + (* [enum] is already present in [enums] *) + enums + | (kk, ee) :: _ when String.equal kk k && not (ee = e) -> + (* [enum] key is already present in [enums], but for a different + [enum]. *) + raise (Invalid_argument "Enum.add: duplicate keys") + | _ :: enums -> add enums + in + add enums + + let bool = + ( "bool", + EnumSpec. + { + path = []; + map = + [ + (0, EnumValueSpec.{name = "false"; doc = default_doc_spec}); + (255, EnumValueSpec.{name = "true"; doc = default_doc_spec}); + ]; + } ) +end + +module Attr = struct + let bool = + AttrSpec. + { + path = []; + id = "bool"; + dataType = DataType.(NumericType (Int_type (Int1Type {signed = false}))); + cond = cond_no_cond; + valid = Some (ValidationAnyOf [IntNum 0; IntNum 255]); + doc = default_doc_spec; + enum = Some (fst Enum.bool); + } + + let u1 = + AttrSpec. + { + path = []; + id = "uint8"; + dataType = DataType.(NumericType (Int_type (Int1Type {signed = false}))); + cond = cond_no_cond; + valid = None; + doc = default_doc_spec; + enum = None; + } +end diff --git a/contrib/lib_kaitai_of_data_encoding/ground.mli b/contrib/lib_kaitai_of_data_encoding/ground.mli new file mode 100644 index 0000000000000000000000000000000000000000..eec3a1fc0650dfe41e9c6993332271d57b7f7648 --- /dev/null +++ b/contrib/lib_kaitai_of_data_encoding/ground.mli @@ -0,0 +1,53 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Marigold, *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** [default_doc_spec] is without summary and references. *) +val default_doc_spec : Kaitai.Types.DocSpec.t + +(** [Enum] module defines enum definitions needed for describing data-encoding + ground types. *) +module Enum : sig + (** [map] describes mapping of enum id (string) with the corresponding + [EnumSpec.t]. *) + type map = (string * Kaitai.Types.EnumSpec.t) list + + (** [bool] is a mapping for boolean type. *) + val bool : string * Kaitai.Types.EnumSpec.t + + (** [add enums enum] returns a list of enum mappings. If [enums] don't contain + [enum], then new list with it is returned, otherwise existing [enums] list + is returned. *) + val add : map -> string * Kaitai.Types.EnumSpec.t -> map +end + +(** [Attr] is module for getting [AttrSpec.t] of ground types. *) +module Attr : sig + (** [bool] returns [AttrSpec.t] definition of bool ground type. *) + val bool : Kaitai.Types.AttrSpec.t + + (** [u1] returns [AttrSpec.t] definition of 8-bit unsigned integer. *) + val u1 : Kaitai.Types.AttrSpec.t +end diff --git a/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_ground_types.ml b/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_ground_types.ml index 9a8e9216966508fb1a80fb9668b6d50f688181aa..3bb40a1110f50bf09563a31deb2455f63a01def3 100644 --- a/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_ground_types.ml +++ b/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_ground_types.ml @@ -42,3 +42,24 @@ let%expect_test "test uint8 translation" = - id: uint8 type: u1 |}] + +let%expect_test "test bool translation" = + let s = + Kaitai_of_data_encoding.Translate.from_data_encoding + ~encoding_name:"ground_bool" + Data_encoding.bool + in + print_endline (Kaitai.Print.print s) ; + [%expect + {| + meta: + id: ground_bool + enums: + bool: + 0: false + 255: true + seq: + - id: bool + type: u1 + enum: bool + |}] diff --git a/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_tuples.ml b/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_tuples.ml new file mode 100644 index 0000000000000000000000000000000000000000..44eff71495b7723e2667e8a16b46866e393ce90c --- /dev/null +++ b/contrib/lib_kaitai_of_data_encoding/test/test_translation_of_tuples.ml @@ -0,0 +1,123 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Marigold, *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let%expect_test "test tuple translation" = + let s = + Kaitai_of_data_encoding.Translate.from_data_encoding + ~encoding_name:"simple_tuple" + Data_encoding.(tup2 bool uint8) + in + print_endline (Kaitai.Print.print s) ; + [%expect + {| + meta: + id: simple_tuple + enums: + bool: + 0: false + 255: true + seq: + - id: field_0 + type: u1 + enum: bool + - id: field_1 + type: u1 + |}] + +let%expect_test "test long tuple translation" = + let s = + Kaitai_of_data_encoding.Translate.from_data_encoding + ~encoding_name:"simple_tuple" + Data_encoding.(tup5 bool uint8 bool uint8 uint8) + in + print_endline (Kaitai.Print.print s) ; + [%expect + {| + meta: + id: simple_tuple + enums: + bool: + 0: false + 255: true + seq: + - id: field_0 + type: u1 + enum: bool + - id: field_1 + type: u1 + - id: field_2 + type: u1 + enum: bool + - id: field_3 + type: u1 + - id: field_4 + type: u1 |}] + +let%expect_test "test tup1 tuple translation" = + let s = + Kaitai_of_data_encoding.Translate.from_data_encoding + ~encoding_name:"tup1" + Data_encoding.(tup1 uint8) + in + print_endline (Kaitai.Print.print s) ; + [%expect + {| + meta: + id: tup1 + seq: + - id: uint8 + type: u1 + |}] + +let%expect_test "test tuples with tup1 translation" = + let s = + Kaitai_of_data_encoding.Translate.from_data_encoding + ~encoding_name:"tup1tup" + Data_encoding.( + tup3 (tup1 bool) (tup2 uint8 bool) (tup2 (tup1 uint8) uint8)) + in + print_endline (Kaitai.Print.print s) ; + [%expect + {| + meta: + id: tup1tup + enums: + bool: + 0: false + 255: true + seq: + - id: field_0 + type: u1 + enum: bool + - id: field_1 + type: u1 + - id: field_2 + type: u1 + enum: bool + - id: field_3 + type: u1 + - id: field_4 + type: u1 |}] diff --git a/contrib/lib_kaitai_of_data_encoding/translate.ml b/contrib/lib_kaitai_of_data_encoding/translate.ml index b9898b5a48623981458840712f1f96316435e17e..79f23cfc262256017a04a0ec9495412b4be38fba 100644 --- a/contrib/lib_kaitai_of_data_encoding/translate.ml +++ b/contrib/lib_kaitai_of_data_encoding/translate.ml @@ -46,15 +46,13 @@ let default_meta_spec ~encoding_name = imports = []; } -let default_doc_spec = DocSpec.{summary = None; refs = []} - let default_class_spec ~encoding_name = ClassSpec. { fileName = None; path = []; meta = default_meta_spec ~encoding_name; - doc = default_doc_spec; + doc = Ground.default_doc_spec; toStringExpr = None; params = []; seq = []; @@ -63,20 +61,60 @@ let default_class_spec ~encoding_name = enums = []; } -let u1_attr_spec = - AttrSpec. - { - path = []; - id = "uint8"; - dataType = DataType.(NumericType (Int_type (Int1Type {signed = false}))); - cond = ConditionalSpec.{ifExpr = None; repeat = RepeatSpec.NoRepeat}; - valid = None; - doc = default_doc_spec; - } +let rec seq_field_of_data_encoding : + type a. + (string * EnumSpec.t) list -> + a Data_encoding.t -> + (string * EnumSpec.t) list * AttrSpec.t list = + fun enums {encoding; json_encoding = _} -> + match encoding with + | Null -> (enums, []) + | Empty -> (enums, []) + | Ignore -> (enums, []) + | Constant _ -> (enums, []) + | Bool -> (Ground.Enum.add enums Ground.Enum.bool, [Ground.Attr.bool]) + | Uint8 -> (enums, [Ground.Attr.u1]) + | Conv {encoding; _} -> seq_field_of_data_encoding enums encoding + | Tup e -> + (* This case corresponds to a [tup1] combinator being called inside a + [tup*] combinator. It's probably never used, but it's still a valid use + of data-encoding. Note that we erase the information that there is an + extraneous [tup1] in the encoding. *) + seq_field_of_data_encoding enums e + | Tups {kind = _; left; right} -> + (* This case corresponds to a [tup*] combinator being called inside a + [tup*] combinator. It's probably never used, but it's still a valid use + of data-encoding. Note that we erase the information that there is an + extraneous [tup*] in the encoding. *) + let enums, left = seq_field_of_data_encoding enums left in + let enums, right = seq_field_of_data_encoding enums right in + let seq = left @ right in + (enums, seq) + | _ -> failwith "Not implemented" -let from_data_encoding : +let rec from_data_encoding : type a. encoding_name:string -> a Data_encoding.t -> ClassSpec.t = fun ~encoding_name {encoding; json_encoding = _} -> match encoding with - | Uint8 -> {(default_class_spec ~encoding_name) with seq = [u1_attr_spec]} + | Bool -> + { + (default_class_spec ~encoding_name) with + seq = [Ground.Attr.bool]; + enums = [Ground.Enum.bool]; + } + | Uint8 -> {(default_class_spec ~encoding_name) with seq = [Ground.Attr.u1]} + | Tup e -> + (* Naked Tup likely due to [tup1]. We simply ignore this constructor. *) + from_data_encoding ~encoding_name e + | Tups {kind = _; left; right} -> + let enums, left = seq_field_of_data_encoding [] left in + let enums, right = seq_field_of_data_encoding enums right in + let seq = left @ right in + let seq = + List.mapi + (fun i attr -> AttrSpec.{attr with id = Printf.sprintf "field_%d" i}) + seq + in + {(default_class_spec ~encoding_name) with seq; enums} + | Conv {encoding; _} -> from_data_encoding ~encoding_name encoding | _ -> failwith "Not implemented"