frontend: support number forms

1 files changed, 23 insertions, 25 deletions

diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index c15e1d1..b1618d3 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-
 module Schema
   ( Schema,
     viewSchema,
@@ -19,10 +16,11 @@ import Data.Aeson.KeyMap qualified as AM
 import Data.List
 import Data.Map qualified as M
 import Data.Maybe
+import Data.Scientific (fromFloatDigits)
 import Data.Set qualified as S
 import Form qualified as F
 import Miso
-import Miso.String (MisoString, fromMisoString, toMisoString)
+import Miso.String (MisoString, fromMisoString, intercalate, toMisoString)
 import Route
 
 data Schema = Schema
@@ -114,26 +112,24 @@ schemaTable collection schema values =
 
 schemaForm :: Schema -> F.Form A.Object A.Object
 schemaForm schema =
-  fmap mergeJson . sequence $
-    ( \((AK.fromText . fromMisoString) -> k, v) ->
-        case v of
-          Type "string" ->
-            if toMisoString (AK.toText k) `S.member` schema.required
-              then
-                AM.singleton k
-                  <$> ( F.mapValues (getO k) (setO k) $
-                          fmap (A.String . fromMisoString) . F.mapValues fromJson toJson $
-                            F.input (toMisoString (AK.toString k))
-                      )
-              else
-                AM.singleton k
-                  <$> ( F.mapValues (getO k) (setO k)
-                          $ fmap (maybe A.Null (A.String . fromMisoString))
-                            . F.mapValues fromJson toJson
-                          $ F.optional (F.input (toMisoString (AK.toString k)))
-                      )
-    )
-      <$> (M.toList schema.properties)
+  let handleOptional k toJson form
+        | toMisoString (AK.toText k) `S.member` schema.required = toJson <$> form
+        | otherwise = maybe A.Null toJson <$> F.optional form
+      typeForm k (Type "number") =
+        Just $ handleOptional k (A.Number . fromFloatDigits) $ F.inputNumber (toMisoString (AK.toString k))
+      typeForm k (Type "string") =
+        Just $
+          handleOptional k (A.String . fromMisoString) $
+            F.inputText (toMisoString (AK.toString k))
+      typeForm _ (Reference _) = Nothing
+   in fmap mergeJson . sequence . catMaybes $
+        ( \((AK.fromText . fromMisoString) -> k, v) ->
+            fmap (AM.singleton k)
+              . F.mapValues (getO k) (setO k)
+              . F.mapValues fromJson toJson
+              <$> typeForm k v
+        )
+          <$> (M.toList schema.properties)
 
 mergeJson :: [A.Object] -> A.Object
 mergeJson = foldl' mergeObject AM.empty
@@ -143,10 +139,12 @@ mergeObject kvs kvs' = AM.union kvs kvs'
 
 fromJson :: A.Value -> MisoString
 fromJson (A.String x) = toMisoString x
+fromJson (A.Number x) = toMisoString (show x)
 fromJson _ = ""
 
 toJson :: MisoString -> A.Value -> A.Value
-toJson x _ = A.String (fromMisoString x)
+toJson x _
+  | otherwise = A.String (fromMisoString x)
 
 getO :: AK.Key -> A.Object -> A.Value
 getO k kvs = fromMaybe A.Null (AM.lookup k kvs)