diff --git a/src/core.ml b/src/core.ml index 7d38dd4..826e065 100644 --- a/src/core.ml +++ b/src/core.ml @@ -377,10 +377,12 @@ module Make (Error : ERROR) = struct ;; let make_optional ?meta field = - let decoder string = - match field.decoder string with - | Ok result -> Ok (Some result) - | Error msg -> Error msg + let decoder strings = + match field.decoder strings, strings with + (* Decoding succeeds with nothing when no strings provided *) + | _, [] -> Ok None + | Ok result, _ -> Ok (Some result) + | Error msg, _ -> Error msg in let validator a = match a with @@ -392,15 +394,12 @@ module Make (Error : ERROR) = struct | Some a -> field.encoder a | None -> [ "None" ] in - make - field.name - meta - decoder - encoder - (Some field.default) - field.type_ - validator - true + let default = + match field.default with + | Some d -> Some (Some d) + | None -> None + in + make field.name meta decoder encoder default field.type_ validator true ;; let make_list ?default ?meta field = @@ -598,6 +597,16 @@ module Make (Error : ERROR) = struct match fields with | [] -> Ok ctor | field :: fields -> + let handle_missing = + match field.decoder [] with + | Ok value -> + (match ctor value with + | ctor -> decode { fields; ctor } fields_assoc + | exception exn -> + let msg = Error.of_string (Printexc.to_string exn) in + Error (field.name, [], msg)) + | Error msg -> Error (field.name, [], msg) + in (match List.assoc field.name fields_assoc with | [] -> (match field.default with @@ -607,15 +616,7 @@ module Make (Error : ERROR) = struct | exception exn -> let msg = Error.of_string (Printexc.to_string exn) in Error (field.name, [], msg)) - | None -> - (match field.decoder [] with - | Ok value -> - (match ctor value with - | ctor -> decode { fields; ctor } fields_assoc - | exception exn -> - let msg = Error.of_string (Printexc.to_string exn) in - Error (field.name, [], msg)) - | Error msg -> Error (field.name, [], msg))) + | None -> handle_missing) | values -> (match field.decoder values with | Ok value -> @@ -626,8 +627,8 @@ module Make (Error : ERROR) = struct Error (field.name, values, msg)) | Error msg -> Error (field.name, values, msg)) | exception Not_found -> - (match field.default with - | Some value -> + (match field.default, Field.is_optional @@ AnyField field with + | Some value, _ -> (match ctor value with | ctor -> decode { fields; ctor } fields_assoc | exception exn -> @@ -638,7 +639,8 @@ module Make (Error : ERROR) = struct | None -> [] in Error (field.name, values, msg)) - | None -> Error (field.name, [], Error.no_value))) + | None, false -> Error (field.name, [], Error.no_value) + | None, true -> handle_missing)) ;; let decode_and_validate schema input = diff --git a/test/test.ml b/test/test.ml index 2710d28..d6fc5e5 100644 --- a/test/test.ml +++ b/test/test.ml @@ -9,9 +9,25 @@ module C = Conformist (* Testing optional fields *) +type occupation = + | Mathematician + | Engineer + +let decoder = function + | [ "mathematician" ] -> Ok Mathematician + | [ "engineer" ] -> Ok Engineer + | _ -> Error "Unknown occupation provided" +;; + +let encoder = function + | Mathematician -> [ "mathematician" ] + | Engineer -> [ "engineer" ] +;; + type schema_optional = { name : string ; address : string option + ; occupation : occupation option } let schema_option_to_sexp s = @@ -38,9 +54,12 @@ let testable_schema_optional = ;; let decode_optional () = - let make name address = { name; address } in + let make name address occupation = { name; address; occupation } in + let custom = C.custom decoder encoder "occupation" in let schema = - C.make [ C.string "name"; C.optional (C.string "address") ] make + C.make + [ C.string "name"; C.optional (C.string "address"); C.optional custom ] + make in Alcotest.( check @@ -48,63 +67,59 @@ let decode_optional () = "has no name" (Error ("name", [], "No value provided")) (C.decode schema [])); + Alcotest.( + check + (testable_decode_result testable_schema_optional) + "has unknown occupation" + (Error ("occupation", [ "programmer" ], "Unknown occupation provided")) + (C.decode schema [ "name", [ "Walter" ]; "occupation", [ "programmer" ] ])); Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Walter" None)) + (Ok (make "Walter" None None)) (C.decode schema [ "name", [ "Walter" ] ])); Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Walter" (Some ""))) + (Ok (make "Walter" (Some "") None)) (C.decode schema [ "name", [ "Walter" ]; "address", [ "" ] ])); Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Walter" None)) - (C.decode schema [ "name", [ "Walter" ]; "address", [] ])); - let expected = Ok (make "Walter" (Some "Pineapple Street 3")) in + (Ok (make "Walter" None None)) + (C.decode + schema + [ "name", [ "Walter" ]; "address", []; "occupation", [] ])); + let expected = + Ok (make "Walter" (Some "Pineapple Street 3") (Some Mathematician)) + in let actual = C.decode schema - [ "name", [ "Walter" ]; "address", [ "Pineapple Street 3" ] ] + [ "name", [ "Walter" ] + ; "address", [ "Pineapple Street 3" ] + ; "occupation", [ "mathematician" ] + ] in Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" expected - actual); - let schema = - C.make - [ C.string "name"; C.optional (C.string ~default:"Default" "address") ] - make - in - Alcotest.( - check - (testable_decode_result testable_schema_optional) - "decodes" - (Ok (make "Walter" (Some "Default"))) - (C.decode schema [ "name", [ "Walter" ] ])); - Alcotest.( - check - (testable_decode_result testable_schema_optional) - "decodes" - (Ok (make "Walter" (Some "Pineapple Street"))) - (C.decode - schema - [ "name", [ "Walter" ]; "address", [ "Pineapple Street" ] ])) + actual) ;; let decode_default () = - let make name address = { name; address } in + let make name address occupation = { name; address; occupation } in + let custom = C.custom decoder encoder ~default:Engineer "occupation" in let schema = C.make [ C.string ~default:"Walter" "name" ; C.optional (C.string ~default:"Default address" "address") + ; C.optional custom ] make in @@ -112,20 +127,43 @@ let decode_default () = check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Walter" (Some "Default address"))) + (Ok (make "Walter" (Some "Default address") (Some Engineer))) (C.decode schema [])); + Alcotest.( + check + (testable_decode_result testable_schema_optional) + "has unknown occupation" + (Error ("occupation", [ "programmer" ], "Unknown occupation provided")) + (C.decode schema [ "name", [ "Walter" ]; "occupation", [ "programmer" ] ])); Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Walter" (Some ""))) + (Ok (make "Walter" (Some "") None)) (C.decode schema [ "address", [ "" ] ])); Alcotest.( check (testable_decode_result testable_schema_optional) "decodes" - (Ok (make "Jesse" (Some "Default address"))) - (C.decode schema [ "name", [ "Jesse" ] ])) + (Ok (make "Walter" (Some "Default address") (Some Engineer))) + (C.decode schema [ "address", []; "occupation", [] ])); + Alcotest.( + check + (testable_decode_result testable_schema_optional) + "decodes" + (Ok (make "Jesse" (Some "Default address") (Some Engineer))) + (C.decode schema [ "name", [ "Jesse" ] ])); + Alcotest.( + check + (testable_decode_result testable_schema_optional) + "decodes" + (Ok (make "Jesse" (Some "Pineapple Street") (Some Mathematician))) + (C.decode + schema + [ "name", [ "Jesse" ] + ; "address", [ "Pineapple Street" ] + ; "occupation", [ "mathematician" ] + ])) ;; (* Testing multiple fields *) @@ -247,9 +285,12 @@ let decode_complete_and_valid_input () = ;; let validate_default () = - let make name address = { name; address } in + let make name address occupation = { name; address; occupation } in + let custom = C.custom decoder encoder "occupation" in let schema = - C.make [ C.string "name"; C.optional (C.string "address") ] make + C.make + [ C.string "name"; C.optional (C.string "address"); C.optional custom ] + make in Alcotest.( check @@ -270,7 +311,10 @@ let validate_default () = [] (C.validate schema - [ "name", [ "Walter" ]; "address", [ "Pineapple Street" ] ])) + [ "name", [ "Walter" ] + ; "address", [ "Pineapple Street" ] + ; "occupation", [ "mathematician" ] + ])) ;; let validate_incomplete_input () =