show form input
This commit is contained in:
@@ -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
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
@@ -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"]]
|
||||
|
||||
@@ -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,19 +160,12 @@ getResponseBody = fromMaybe "" . contents
|
||||
|
||||
viewModel :: Model -> View Action
|
||||
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 viewPosts) model.posts,
|
||||
maybe
|
||||
(text "..")
|
||||
( either
|
||||
err
|
||||
( fmap (either FormChanged FormSubmitted)
|
||||
. flip F.runForm (A.Object AM.empty)
|
||||
. schemaForm
|
||||
)
|
||||
)
|
||||
model.schema
|
||||
maybe (text "..") (either err (viewForm input)) model.schema,
|
||||
viewInput input
|
||||
]
|
||||
|
||||
err :: String -> View Action
|
||||
@@ -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 $
|
||||
|
||||
Reference in New Issue
Block a user