The intent of this small program is to show three buttons, with the third button's label initially being "0" and afterwards being the index of the last-clicked button. For now the number of buttons and the labels of the other buttons are constant.
When I compile this self-contained file with ghcjs and load Main.jsexe/index.html in the browser, I can see the two traceDyns firing in a loop, both always having the value 0. As far as I understand, nothing should happen until a button is clicked, because the _el_clicked feeds the rest of the system.
Also, note that I'm using mapDyn (fst . head . Map.toList)
in order to extract the index of the selected button - I'm not sure this is correct, but either way I don't know what causes the infinite looping.
{-# LANGUAGE RecursiveDo #-}
module Main where
import Reflex
import Reflex.Dom
import qualified Data.Map as Map
dynButton
:: MonadWidget t m
=> Dynamic t String
-> m (Event t ())
dynButton s = do
(e, _) <- el' "button" $ dynText s
return $ _el_clicked e
-- widget that takes dynamic list of strings
-- and displays a button for each, returning
-- an event of chosen button's index
listChoiceWidget
:: MonadWidget t m
=> Dynamic t [String]
-> m (Event t Int)
listChoiceWidget choices = el "div" $ do
asMap <- mapDyn (Map.fromList . zip [(0::Int)..]) choices
evs <- listWithKey asMap (\_ s -> dynButton s)
k <- mapDyn (fst . head . Map.toList) evs
return $ updated (traceDyn "k" k)
options :: MonadWidget t m => Dynamic t Int -> m (Dynamic t [String])
options foo = do
mapDyn (\x -> ["a", "b", show x]) foo
main :: IO ()
main = mainWidget $ el "div" $ do
rec n <- listChoiceWidget o
o <- options foo
foo <- holdDyn 0 n
display (traceDyn "foo" foo)
It looks like your code for listChoiceWidget is throwing away the click events constructed by dynButton.
listWithKey
returnsm (Dynamic t (Map k a))
. In your case, the keys are of typeInt
and the values areEvent t ()
(produced by dynButton).On this line:
You are turning the
Dynamic t (Map Int (Event t ()))
into aDynamic t Int
but, crucially, you're not doing so when a click event fires. This line maps overevs
and produces a Dynamic that will always contain the first key in the Map of Ints to Events, regardless of whether an event has fired or not. It will always be a Dynamic containing the Int 0.The reason you're seeing a loop is because:
main
feedsfoo
with its initial value of 0 intooptions
listChoiceWidget
receives the new options and the list is updatedfoo
receives the key updated event fromlistChoiceWidget
Instead of retrieving the first key out of the Map, you need some way of determining the last button click event. Your Map already contains click events for each button displayed. Right now those events have the type
Event t ()
, but what you really need isEvent t Int
, so that when an event fires you can tell which button it came from.evs'
has the typeDynamic t (Map Int (Event t Int))
. Next we need some way of combining our events so that we have one event that fires with the most recently clicked button's key.dynEv
now has the typeDynamic t (Event t Int)
. The keys of the Map have already been baked into the events, so we don't need them anymore.Map.elems
turns our Map of events into a list of events, andleftmost
allows you to combine a list of events into one event.From the docs for
leftmost
: "Create a new Event that occurs if at least one of the Events in the list occurs. If multiple occur at the same time they are folded from the left with the given function."Finally, we need to convert your
Dynamic t (Event t Int)
into anEvent t Int
. We're going to useswitch
, which takes aBehavior t (Event t a)
and returns anEvent t a
. So, the following line will result inEvent t Int
.current
extracts theBehavior
of aDynamic
, andswitch
creates "an Event that will occur whenever the currently-selected input Event occurs."Here's the revised
listChoiceWidget
code. I've included inline type annotations, so you'll need theScopedTypeVariables
language extension enabled to compile this code (or you can remove the annotations).Here's a gist of the complete file.