If there are more than one key listener, all but the first are ignored.

[Quelklef]

If there are more than one key listeners, then all but the first are ignored.

In the example given, I have a <div> which is set up to listen to arrow key presses. Each key has its own listener. When a listener is invoked, the model is updated to display which arrow key is pressed. When I click on the <div>, and press all 4 arrow keys, only the key with the earliest-attached listener is recognized.

As I change the order of event listeners, which key is recognized changes accordingly. Please see the included gif.

MWE code:

module Main where

import Prelude

import Effect (Effect)
import Effect.Uncurried (runEffectFn1)
import Data.Maybe (Maybe(..))
import Data.Foldable (fold, length, intercalate)
import Data.Array (slice)

import Platform as Platform
import Html (Html)
import Html as H
import Css as S
import Attribute as A
import Attribute (Attribute)
import WHATWG.HTML.KeyboardEvent (toMaybeKeyboardEvent, key) as Wwg

type Model =
  { directions :: Array String
  , lastPressed :: String
  }

data Msg = Msg_Noop | Msg_RotateDirections | Msg_Set String

initialModel :: Model
initialModel =
  { directions: ["Up", "Down", "Left", "Right"]
  , lastPressed: "<none>"
  }

main :: Effect Unit
main = do
  let app = Platform.app
        { init: \_ -> pure initialModel
        , subscriptions: \_ -> mempty
        , update: \model msg -> pure (update model msg)
        , view: view
        }
  (runEffectFn1 app) unit

update :: Model -> Msg -> Model
update model Msg_Noop = model
update model Msg_RotateDirections =
  model { directions =  slice 1 (length model.directions) model.directions <> slice 0 1 model.directions }
update model (Msg_Set lastPressed) = model { lastPressed = lastPressed }

view :: Model -> { head :: Array (Html Msg), body :: Array (Html Msg) }
view model =
  { head: []
  , body:
    [ H.p [ ]
      [ H.text $ "Order of event listeners is: " <> (model.directions # intercalate ", ")
      , H.text " "
      , H.button [ A.onClick Msg_RotateDirections ] [ H.text "rotate" ]
      ]
    , H.divS
      [ S.backgroundColor "rgba(0 200 0 / 20%)" ]
      [ A.tabindex "0" {- required to pick up keypresses -}
      , fold $ model.directions # map \dir -> onKey ("Arrow" <> dir) (Msg_Set dir)
      ]
      [ H.text "Click here then press an arrow key" ]
    , H.p [ ] [ H.text $ "The last arrow key pressed was: " <> model.lastPressed ]
    ]
  }

onKey :: String -> Msg -> Attribute Msg
onKey key msg =
  A.on "keydown" \event -> pure $
    case Wwg.toMaybeKeyboardEvent event of
      Nothing -> Msg_Noop
      Just keyEvent -> do
        let keyOk = Wwg.key keyEvent == key
        if keyOk then msg else Msg_Noop

[Quelklef]

FWIW, for the sake of efficiency, it may make sense to have on be on :: forall msg. String -> (Event -> Effect (Maybe msg)) -> Attribute msg

[ursi]

Okay I think I know what's happening here. I think what's going on is that because A.on "keydown" is using a lambda, it can't detect that the subscriptions are the same, so after the first one fires, the model updates, then the remaining subscriptions are canceled because there is nothing in the next batch of subscriptions that are equal to them.

[ursi]

I'm gonna make something to test this hypothesis.

[ursi]

This is indeed the case, as demonstrated by this working code

module Main where

import Prelude

import Effect (Effect)
import Effect.Uncurried (runEffectFn1)
import Data.Maybe (Maybe(..))
import Data.Foldable (fold, length, intercalate)
import Data.Array (slice)

import Platform as Platform
import Html (Html)
import Html as H
import Css as S
import Attribute as A
import Attribute (Attribute)
import WHATWG.HTML.KeyboardEvent (toMaybeKeyboardEvent, key) as Wwg

import WHATWG.HTML.All (Event)

type Model =
  { directions :: Array String
  , lastPressed :: String
  }

data Msg = Msg_Noop | Msg_RotateDirections | Msg_Set String

derive instance eqMsg :: Eq Msg

initialModel :: Model
initialModel =
  { directions: ["Up", "Down", "Left", "Right"]
  , lastPressed: "<none>"
  }

main :: Effect Unit
main = do
  let app = Platform.app
        { init: \_ -> pure initialModel
        , subscriptions: \_ -> mempty
        , update: \model msg -> pure (update model msg)
        , view: view
        }
  (runEffectFn1 app) unit

update :: Model -> Msg -> Model
update model Msg_Noop = model
update model Msg_RotateDirections =
  model { directions =  slice 1 (length model.directions) model.directions <> slice 0 1 model.directions }
update model (Msg_Set lastPressed) = model { lastPressed = lastPressed }

view :: Model -> { head :: Array (Html Msg), body :: Array (Html Msg) }
view model =
  { head: []
  , body:
    [ H.p [ ]
      [ H.text $ "Order of event listeners is: " <> (model.directions # intercalate ", ")
      , H.text " "
      , H.button [ A.onClick Msg_RotateDirections ] [ H.text "rotate" ]
      ]
    , H.divS
      [ S.backgroundColor "rgba(0 200 0 / 20%)" ]
      [ A.tabindex "0" {- required to pick up keypresses -}
      , onKeys
      ]
      [ H.text "Click here then press an arrow key" ]
    , H.p [ ] [ H.text $ "The last arrow key pressed was: " <> model.lastPressed ]
    ]
  }

something :: String -> Msg -> Event -> Effect Msg
something key msg = \event -> pure $
    case Wwg.toMaybeKeyboardEvent event of
      Nothing -> Msg_Noop
      Just keyEvent -> do
        let keyOk = Wwg.key keyEvent == key
        if keyOk then msg else Msg_Noop

onKeys :: Attribute Msg
onKeys =
  initialModel.directions
  <#> (\dir ->
         A.on "keydown"
         $ something ("Arrow" <> dir) (Msg_Set dir)
      )
  # fold

Now the question is, what to do about it.

[Quelklef]

A quick-fix would be to require a Monoid msg instance and then fold all the messages before calling update

[Quelklef]

This may be annoying for the end-user, but at most it will require them to use [msg] instead of msg

[ursi]

Yeah I don't like that. I think a better quick fix, and potentially the fix is to change the type of on to ∀ msg. String -> Producer (Event -> Effect msg) -> Attribute msg.

[Quelklef]

I have yet to grok Producer, but I'll take your word for it

[ursi]

That API change would turn

onKey :: String -> Msg -> Attribute Msg
onKey key msg =
  A.on "keydown" \event -> pure $
    case Wwg.toMaybeKeyboardEvent event of
      Nothing -> Msg_Noop
      Just keyEvent -> do
        let keyOk = Wwg.key keyEvent == key
        if keyOk then msg else Msg_Noop

into something like

onKey :: String -> Msg -> Attribute Msg
onKey key msg =
  A.on "keydown" $ mkProducer onKeyHelper $ key /\ msg

onKeyHelper :: String /\ Msg -> (Event -> Effect Msg)
onKeyHelper (key /\ msg) =
  \event -> pure $
    case Wwg.toMaybeKeyboardEvent event of
      Nothing -> Msg_Noop
      Just keyEvent -> do
        let keyOk = Wwg.key keyEvent == key
        if keyOk then msg else Msg_Noop

[Quelklef]

This looks reasonable

[ursi]

This should be fixed in 61776e639d92a2af23d49f56fce78ecd871f8297

[Quelklef]

:tada:

[ursi]

I guess I should clarify. This will still break in the same way if you don't make the Producers equal, but I'm not sure anything can be done about that without a huge change, as it's really just a consequence of it working properly. I'd be curious to see if Elm has the same limitation.