show form input

This commit is contained in:
Alexander Foremny
2024-06-04 09:59:10 +02:00
parent 342ebdf61b
commit 9d3c32956b
3 changed files with 30 additions and 24 deletions

View File

@@ -29,7 +29,8 @@ import Miso.String (toMisoString)
data Model = Model
{ schema :: Maybe (Either String Schema),
posts :: Maybe (Either String [A.Value])
posts :: Maybe (Either String [A.Value]),
input :: Maybe A.Value
}
deriving (Show, Eq, Generic, Default)
@@ -111,8 +112,10 @@ updateModel action m =
let setPosts :: Either String [A.Value] -> Model -> Model
setPosts posts m = m {posts = Just posts}
in noEff (setPosts posts m)
FormChanged _ -> noEff m
FormSubmitted _ -> noEff m
FormChanged (Just -> input) -> noEff m {input}
FormSubmitted output ->
m <# do
const NoOp <$> consoleLog (toMisoString (A.encode output))
fetchSchema :: JSM (Either String Schema)
fetchSchema =
@@ -157,20 +160,13 @@ getResponseBody = fromMaybe "" . contents
viewModel :: Model -> View Action
viewModel model =
div_ [] $
[ maybe (text "..") (either err viewSchema) model.schema,
maybe (text "..") (either err viewPosts) model.posts,
maybe
(text "..")
( either
err
( fmap (either FormChanged FormSubmitted)
. flip F.runForm (A.Object AM.empty)
. schemaForm
)
)
model.schema
]
let input = fromMaybe (A.Object AM.empty) model.input
in div_ [] $
[ maybe (text "..") (either err viewSchema) model.schema,
maybe (text "..") (either err viewPosts) model.posts,
maybe (text "..") (either err (viewForm input)) model.schema,
viewInput input
]
err :: String -> View Action
err = text . toMisoString . ("err! " <>)
@@ -189,6 +185,16 @@ viewSchema schema =
)
<$> (M.toList properties)
viewForm :: A.Value -> Schema -> View Action
viewForm input =
fmap (either FormChanged FormSubmitted)
. flip F.runForm input
. schemaForm
viewInput :: A.Value -> View Action
viewInput input =
pre_ [] [text (toMisoString (A.encode input))]
schemaForm :: Schema -> F.Form A.Value A.Value
schemaForm schema =
fmap mergeJson . sequence $