diff options
Diffstat (limited to 'frontend/app/Schema.hs')
| -rw-r--r-- | frontend/app/Schema.hs | 86 |
1 files changed, 65 insertions, 21 deletions
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) |