From 962f04ddc339db8e1f10e5f4eb68c0d5039e1e5e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kier=C3=A1n=20Meinhardt?= <kmein@posteo.de>
Date: Sun, 13 Oct 2024 15:09:21 +0200
Subject: wip: add forms for unions

---
 frontend/app/Schema.hs | 86 ++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 65 insertions(+), 21 deletions(-)

(limited to 'frontend/app/Schema.hs')

diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index b1618d3..8e3b7da 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -51,12 +51,14 @@ instance A.FromJSONKey MisoString where
 data Property
   = Type MisoString
   | Reference MisoString
+  | Union [MisoString]
   deriving (Show, Eq)
 
 instance A.FromJSON Property where
   parseJSON = A.withObject "Property" $ \v ->
     (Type <$> v A..: "type")
       <|> (Reference <$> v A..: "$ref")
+      <|> (fmap Union $ traverse (A..: "type") =<< v A..: "oneOf")
 
 viewSchema :: Schema -> View action
 viewSchema schema =
@@ -69,6 +71,7 @@ viewSchema schema =
               ( case v of
                   Type v -> toMisoString v
                   Reference v -> "reference to " <> toMisoString v
+                  Union vs -> Miso.String.intercalate " or " vs
               ),
             text (if k `S.member` schema.required then "" else "?")
           ]
@@ -112,24 +115,67 @@ schemaTable collection schema values =
 
 schemaForm :: Schema -> F.Form A.Object A.Object
 schemaForm schema =
-  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)
+  fmap mergeJson . sequence . catMaybes $
+    ( \((AK.fromText . fromMisoString) -> k, v) ->
+        case v of
+          Type "string" ->
+            Just $
+              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.inputText (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.inputText (toMisoString (AK.toString k)))
+                        )
+          Type "number" ->
+            Just $
+              if toMisoString (AK.toText k) `S.member` schema.required
+                then
+                  AM.singleton k
+                    <$> ( F.mapValues (getO k) (setO k) $
+                            fmap ((A.Number . fromFloatDigits)) . F.mapValues fromJson toJson $
+                              F.inputNumber (toMisoString (AK.toString k))
+                        )
+                else
+                  AM.singleton k
+                    <$> ( F.mapValues (getO k) (setO k)
+                            $ fmap (maybe A.Null (A.Number . fromFloatDigits))
+                              . F.mapValues fromJson toJson
+                            $ F.optional (F.inputNumber (toMisoString (AK.toString k)))
+                        )
+          Reference _ -> Nothing
+          Union typeStrings ->
+            let mapOutput = \case
+                  F.IsString s -> A.String s
+                  F.IsNumber i -> A.Number (fromIntegral i)
+                typeStringToType "number" = F.NumberType
+                typeStringToType "string" = F.StringType
+             in Just $
+                  if toMisoString (AK.toText k) `S.member` schema.required
+                    then
+                      AM.singleton k
+                        <$> ( F.mapValues (getO k) (setO k) $
+                                F.mapValues fromJson toJson $
+                                  F.mapValues _getter _setter $
+                                    fmap mapOutput <$>
+                                      F.inputUnion (toMisoString (AK.toString k)) (map typeStringToType typeStrings)
+                            )
+                    else undefined
+                    -- AM.singleton k
+                    --   <$> ( F.mapValues (getO k) (setO k)
+                    --           $ fmap (maybe A.Null (A.Number . fromFloatDigits))
+                    --             . F.mapValues fromJson toJson
+                    --           $ F.optional unionForm
+                    --       )
+    )
+      <$> (M.toList schema.properties)
 
 mergeJson :: [A.Object] -> A.Object
 mergeJson = foldl' mergeObject AM.empty
@@ -139,12 +185,10 @@ 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 _
-  | otherwise = A.String (fromMisoString x)
+toJson x _ = A.String (fromMisoString x)
 
 getO :: AK.Key -> A.Object -> A.Value
 getO k kvs = fromMaybe A.Null (AM.lookup k kvs)
-- 
cgit v1.2.3