ReflexFRP: How to set button text from textInput on button click

Question

I have a simple widget that should set the "text" of a button from a given text input field.

While I managed to do a simple clear functionality

buttonWidget :: MonadWidget t m => m ()
buttonWidget = do
  send  <- button "clear"
  input <- textInput $ def & setValue .~ fmap (const "") send
  return ()

I did not manage to set the button label - the code below compiles

buttonWidget :: MonadWidget t m => m ()
buttonWidget = do
  rec send  <- button val
      input <- textInput $ def & setValue .~ fmap (const "") send
      val   <- sample $ current $ view textInput_value input
  return ()

but looking at the output index.html - I get only a white page with a console error message:

rts.js:7313 thread blocked indefinitely in an MVar operation

Answer 1

What happens here is that button takes String (or Text, depending on version), and this string depends on the value of text input, which, in turn, depends on the event produced by a button. Now, normally similar loops in event network are just fine, but here you need to sample the input value to obtain the text before the button is even rendered (because it needs that text to render to DOM).

Following code (written in hsnippet, so older reflex-dom, and simplified (no lens), shows how one can defined a 'button' helper that does not need to have the input text realized before being written to DOM:

app :: MonadWidget t m => App t m ()
app = do
  rec send  <- button' $ _textInput_value input
      input <- textInput $ def { _textInputConfig_setValue = fmap (const "") send }
  return ()

button' :: MonadWidget t m => Dynamic t String -> m (Event t ())
button' s = do
  (e, _) <- elAttr' "button" (M.singleton "type" "button") $ dynText s
  return $ domEvent Click e

Answer 2

It seems that vanilla buttons in reflex-dom do not support dynamic labeling; so for the

solutionWidget :: MonadWidget t m => m ()
solutionWidget = do
  rec send  <- dynButton dyn
      input <- textInput $ def & setValue .~ fmap (const "") send
      dyn <- holdDyn "click button to set text below"
                     (tag (current $ view textInput_value input) send)
  return ()

we need to define the following:

dynButton :: MonadWidget t m => Dynamic t Text -> m (Event t ())
dynButton s = do
  (e, _) <- elAttr' "button" (Map.singleton "type" "button") $ dynText s
  return $ domEvent Click e