From e8a8de56f68b6c5f738a09950e66b6df9bbb2e70 Mon Sep 17 00:00:00 2001
From: Dillon Kearns <dillon@incrementalelm.com>
Date: Mon, 10 Jan 2022 12:25:35 -0800
Subject: [PATCH] Handle required vs. optional dates.

---
 examples/pokedex/src/Page/Form.elm         |  2 +-
 examples/pokedex/src/Page/TailwindForm.elm |  2 +-
 src/Form.elm                               | 69 +++++++++++++++++++---
 3 files changed, 63 insertions(+), 10 deletions(-)

diff --git a/examples/pokedex/src/Page/Form.elm b/examples/pokedex/src/Page/Form.elm
index c333b3fe..5d690ba0 100644
--- a/examples/pokedex/src/Page/Form.elm
+++ b/examples/pokedex/src/Page/Form.elm
@@ -141,7 +141,7 @@ form user =
                 |> Form.withInitialValue user.email
             )
         |> Form.with
-            (Form.date
+            (Form.requiredDate
                 "dob"
                 (\{ toInput, toLabel, errors } ->
                     Html.div []
diff --git a/examples/pokedex/src/Page/TailwindForm.elm b/examples/pokedex/src/Page/TailwindForm.elm
index db162676..413ee482 100644
--- a/examples/pokedex/src/Page/TailwindForm.elm
+++ b/examples/pokedex/src/Page/TailwindForm.elm
@@ -252,7 +252,7 @@ form user =
                 |> Form.required
             )
         |> Form.with
-            (Form.date
+            (Form.requiredDate
                 "dob"
                 (textInput "Date of Birth")
                 |> Form.withInitialValue (user.birthDay |> Date.toIsoString)
diff --git a/src/Form.elm b/src/Form.elm
index 3f785fd3..31c4037f 100644
--- a/src/Form.elm
+++ b/src/Form.elm
@@ -61,16 +61,20 @@ http url_ (Form fields decoder serverValidations modelToValue) model =
 errorCodec : Codec Error
 errorCodec =
     Codec.custom
-        (\vCustom vMissing value ->
+        (\vCustom vMissing vInvalidDate value ->
             case value of
                 Error string ->
                     vCustom string
 
                 MissingRequired ->
                     vMissing
+
+                InvalidDate ->
+                    vInvalidDate
         )
         |> Codec.variant1 "Custom" Error Codec.string
         |> Codec.variant0 "MissingRequired" MissingRequired
+        |> Codec.variant0 "InvalidDate" InvalidDate
         |> Codec.buildCustom
 
 
@@ -638,6 +642,7 @@ number name toHtmlFn =
 type Error
     = Error String
     | MissingRequired
+    | InvalidDate
 
 
 requiredNumber :
@@ -685,8 +690,7 @@ date :
          }
          -> view
         )
-    -- TODO should be Date type
-    -> Field Date view { min : Date, max : Date }
+    -> Field (Maybe Date) view { min : Date, max : Date }
 date name toHtmlFn =
     Field
         { name = name
@@ -699,15 +703,61 @@ date name toHtmlFn =
                 toHtmlFn (toInputRecord name Nothing info fieldInfo)
         , decode =
             \rawString ->
-                rawString
-                    |> Maybe.withDefault ""
-                    -- TODO should empty string be decoded into Nothing instead of an error?
-                    |> Date.fromIsoString
-                    |> Result.mapError Error
+                if (rawString |> Maybe.withDefault "") == "" then
+                    Ok Nothing
+
+                else
+                    rawString
+                        |> Maybe.withDefault ""
+                        |> Date.fromIsoString
+                        |> Result.mapError (\_ -> InvalidDate)
+                        |> Result.map Just
         , properties = []
         }
 
 
+requiredDate :
+    String
+    ->
+        ({ toInput : List (Html.Attribute Msg)
+         , toLabel : List (Html.Attribute Msg)
+         , errors : List Error
+         }
+         -> view
+        )
+    -> Field Date view { min : Date, max : Date }
+requiredDate name toHtmlFn =
+    Field
+        { name = name
+        , initialValue = Nothing
+        , type_ = "date"
+        , required = True
+        , serverValidation = \_ -> DataSource.succeed []
+        , toHtml =
+            \_ fieldInfo info ->
+                toHtmlFn (toInputRecord name Nothing info fieldInfo)
+        , decode =
+            \rawString ->
+                rawString
+                    |> validateRequiredField
+                    |> Result.andThen
+                        (\rawDateString ->
+                            Date.fromIsoString rawDateString
+                                |> Result.mapError (\_ -> InvalidDate)
+                        )
+        , properties = []
+        }
+
+
+validateRequiredField : Maybe String -> Result Error String
+validateRequiredField maybeRaw =
+    if (maybeRaw |> Maybe.withDefault "") == "" then
+        Err MissingRequired
+
+    else
+        Ok (maybeRaw |> Maybe.withDefault "")
+
+
 checkbox :
     String
     -> Bool
@@ -848,6 +898,9 @@ errorToString error =
         Error errorString ->
             errorString
 
+        InvalidDate ->
+            "Invalid date"
+
 
 withClientValidation : (value -> Result String mapped) -> Field value view constraints -> Field mapped view constraints
 withClientValidation mapFn (Field field) =