Correctly handle optionals with no defaults

oxidizing · Jan 11, 2022 · 81f3ca2 · 81f3ca2
1 parent c356094
commit 81f3ca2
Show file tree

Hide file tree

Showing 2 changed files with 107 additions and 61 deletions.
diff --git 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
@@ -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,94 +54,116 @@ 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
       (testable_decode_result testable_schema_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
   Alcotest.(
     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 () =