diff options
author | Alexander Foremny <aforemny@posteo.de> | 2024-06-04 09:59:10 +0200 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2024-06-04 09:59:10 +0200 |
commit | 9d3c32956baab4dc4e1fd114e586b48d850a14c9 (patch) | |
tree | d0de8ff50ffe9bfaeeebc58fbca9a76157614fef /frontend/app | |
parent | 342ebdf61b3b9021b9e58cfce607e96a6e7ae54e (diff) |
show form input
Diffstat (limited to 'frontend/app')
-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 $ |