show form input
This commit is contained in:
@@ -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
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|||||||
@@ -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"]]
|
||||||
]
|
|
||||||
|
|||||||
@@ -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 $
|
||||||
|
|||||||
Reference in New Issue
Block a user