diff options
| -rw-r--r-- | frontend/app/Form/Input.hs | 5 | ||||
| -rw-r--r-- | frontend/app/Form/Internal.hs | 9 | ||||
| -rw-r--r-- | frontend/app/Main.hs | 40 |
3 files changed, 30 insertions, 24 deletions
diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs index a9648c4..4b1eac8 100644 --- a/frontend/app/Form/Input.hs +++ b/frontend/app/Form/Input.hs @@ -6,7 +6,7 @@ where import Data.Text qualified as T import Form.Internal import Miso -import Miso.String (toMisoString) +import Miso.String (fromMisoString, toMisoString) string :: String -> Form T.Text T.Text string label = @@ -17,7 +17,8 @@ string label = [ text (toMisoString label), input_ [ type_ "text", - value_ (toMisoString i) + value_ (toMisoString i), + onInput fromMisoString ] ] ] diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs index 7782368..8c9935f 100644 --- a/frontend/app/Form/Internal.hs +++ b/frontend/app/Form/Internal.hs @@ -53,8 +53,7 @@ mapValues get set (Form {view, fill}) = } runForm :: Form i o -> i -> View (Either i o) -runForm (Form {view}) i = - div_ [] $ - (fmap Left <$> view i) - <> [ button_ [type_ "submit"] [text "submit"] - ] +runForm form i = + form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $ + (fmap Left <$> form.view i) + <> [button_ [type_ "submit"] [text "submit"]] diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs index 45b828b..356aa6e 100644 --- a/frontend/app/Main.hs +++ b/frontend/app/Main.hs @@ -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 $ |