support optional fields

4 files changed, 37 insertions, 10 deletions

diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs
index 4b1eac8..80044ec 100644
--- a/frontend/app/Form/Input.hs
+++ b/frontend/app/Form/Input.hs
@@ -1,5 +1,5 @@
 module Form.Input
-  ( string,
+  ( input,
   )
 where
 
@@ -8,8 +8,8 @@ import Form.Internal
 import Miso
 import Miso.String (fromMisoString, toMisoString)
 
-string :: String -> Form T.Text T.Text
-string label =
+input :: String -> Form T.Text T.Text
+input label =
   Form
     { view = \i ->
         [ div_ [] $
diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs
index 8c9935f..2274c63 100644
--- a/frontend/app/Form/Internal.hs
+++ b/frontend/app/Form/Internal.hs
@@ -2,9 +2,11 @@ module Form.Internal
   ( Form (..),
     mapValues,
     runForm,
+    optional,
   )
 where
 
+import Data.Text qualified as T
 import Miso
 
 data Form i o = Form
@@ -57,3 +59,16 @@ runForm form i =
   form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $
     (fmap Left <$> form.view i)
       <> [button_ [type_ "submit"] [text "submit"]]
+
+class IsEmpty i where
+  isEmpty :: i -> Bool
+
+instance IsEmpty T.Text where
+  isEmpty = T.null . T.strip
+
+optional :: (IsEmpty i) => Form i o -> Form i (Maybe o)
+optional form =
+  Form
+    { view = \i -> form.view i,
+      fill = \i -> if isEmpty i then Right Nothing else Just <$> form.fill i
+    }
diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs
index 294d1c9..d5a87e7 100644
--- a/frontend/app/Page/EditValue.hs
+++ b/frontend/app/Page/EditValue.hs
@@ -10,6 +10,7 @@ where
 import Api
 import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as AM
+import Data.ByteString.Lazy.UTF8 as LB
 import Data.Maybe
 import Form qualified as F
 import Miso
@@ -52,7 +53,8 @@ viewModel m = do
   let input = (fromMaybe (A.Object AM.empty) m.input)
   div_ [] $
     [ viewForm input m.schema,
-      viewInput input
+      viewInput input,
+      viewOutput input m.schema
     ]
 
 viewForm :: A.Value -> Schema -> View Action
@@ -64,3 +66,13 @@ viewForm input =
 viewInput :: A.Value -> View Action
 viewInput input =
   pre_ [] [text (toMisoString (A.encode input))]
+
+viewOutput :: A.Value -> Schema -> View Action
+viewOutput input schema =
+  pre_ [] $
+    [ text $
+        toMisoString
+          ( either ("Left " <>) (("Right " <>) . LB.toString) $
+              (A.encode <$> ((schemaForm schema).fill input))
+          )
+    ]
diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index 0530061..1a52f52 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -115,12 +115,15 @@ schemaForm schema =
               "string" ->
                 A.Object . AM.singleton k
                   <$> ( F.mapValues (getO k) (setO k) $
-                          jsonString (AK.toString k)
+                          fmap A.String . F.mapValues fromJson toJson $
+                            F.input (AK.toString k)
                       )
               "string?" ->
                 A.Object . AM.singleton k
-                  <$> ( F.mapValues (getO k) (setO k) $
-                          jsonString (AK.toString k)
+                  <$> ( F.mapValues (getO k) (setO k)
+                          $ fmap (maybe A.Null A.String)
+                            . F.mapValues fromJson toJson
+                          $ F.optional (F.input (AK.toString k))
                       )
         )
           <$> (M.toList properties)
@@ -143,6 +146,3 @@ getO k (A.Object kvs) = fromMaybe A.Null (AM.lookup k kvs)
 
 setO :: AK.Key -> A.Value -> A.Value -> A.Value
 setO k v (A.Object kvs) = A.Object (AM.insert k v kvs)
-
-jsonString :: String -> F.Form A.Value A.Value
-jsonString = fmap A.String . F.mapValues fromJson toJson . F.string