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

@@ -6,7 +6,7 @@ where
import Data.Text qualified as T import Data.Text qualified as T
import Form.Internal import Form.Internal
import Miso import Miso
import Miso.String (toMisoString) import Miso.String (fromMisoString, toMisoString)
string :: String -> Form T.Text T.Text string :: String -> Form T.Text T.Text
string label = string label =
@@ -17,7 +17,8 @@ string label =
[ text (toMisoString label), [ text (toMisoString label),
input_ input_
[ type_ "text", [ type_ "text",
value_ (toMisoString i) value_ (toMisoString i),
onInput fromMisoString
] ]
] ]
] ]

View File

@@ -53,8 +53,7 @@ mapValues get set (Form {view, fill}) =
} }
runForm :: Form i o -> i -> View (Either i o) runForm :: Form i o -> i -> View (Either i o)
runForm (Form {view}) i = runForm form i =
div_ [] $ form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $
(fmap Left <$> view i) (fmap Left <$> form.view i)
<> [ button_ [type_ "submit"] [text "submit"] <> [button_ [type_ "submit"] [text "submit"]]
]

View File

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