Elm: adding click events to SVG elements doesn't work – is this possible?

Question

I have been attempting to add an on "click" event to an SVG element in Elm in order to determine the relative position of the mouse click within that element.

A code sample is given below that you can try running at http://elm-lang.org/try to show how click events on HTML elements seem to work as expected but not on SVG elements.

In the sample, Html.on "click" is used rather than Html.onClick to allow the position data to be decoded from the event as explained in this discussion.

After reading the documentation and the source code, I would expect that when the on "click" event is added to an SVG element it would work in the same manner as adding the event to an HTML element. However when this is done, clicking the SVG element does not trigger the event and no message is sent to the update function.

In this example, clicking within the black SVG rect should trigger the update function and change the position of the white rect but the clicks are ignored. This can be confirmed by opening the console and noting that the Debug.log is not invoked. An HTML div is placed below with an identical click event and when a click is registered inside this div, the white rect changes position.

Is this intended behaviour in Elm and are there any workarounds?

A similar question has been asked on stackoverflow here but this is referring to canvas shapes which, as far as I'm aware, is a completely separate issue (I may be wrong though).

Code sample:

import Html exposing (Html, div)
import Html.App as App
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (object2, int, at)
import Mouse exposing (Position)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)

main =
  App.beginnerProgram
    { model = model
    , view = view
    , update = update
    }

type alias Model =
  Position

type Msg
  = ChangePosition Position

model : Model
model =
  Position 0 0

update : Msg -> Model -> Model
update msg _ =
  case Debug.log "msg" msg of
    ChangePosition position ->
      position

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.x)
            , y "20"
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
  on "click"
    (Json.map
      ChangePosition
      (object2
        Position
        (object2 (-)
          (at [ "pageX" ] int)
          (at [ "target", "offsetLeft" ] int)
        )
        (object2 (-)
          (at [ "pageY" ] int)
          (at [ "target", "offsetTop" ] int)
        )
      )
    )

Answer 1

The reason Json decoder did not work is obvious because none of offsetLeft nor offsetTop exist in the event object.

It is somewhat confusing as those properties are available for click event of Html DOM but not for SVG DOM. (My suggestion of implementing event decoders in Elm is to attach temporary event handler in browser's debugger console and study the actual event object. Elm's decoder silently fails and hard to know why the decoder did not work. )

Here, I implemented an alternate way how you can use port to get parent position using javascript (without using any community libraries).

port module Main exposing (main)

import Html exposing (Html, div)
import Html.App as App
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (object2, object1, int, at)
import Mouse exposing (Position)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)

main : Program Never
main =
  App.program
    { init = (initmodel, getParentPos ())
    , view = view
    , update = update
    , subscriptions = subscriptions
    }

type alias Model =
  { position : Position
  , parentPosition : Position
  }

type Msg
  = ChangePosition Position
  | UpdateParentPosition { top : Int, left : Int }

initmodel : Model
initmodel =
  { position = Position 0 0
  , parentPosition = Position 0 0
  }

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case Debug.log "msg" msg of
    ChangePosition position ->
      let
        relativepos = Position
          ( position.x - model.parentPosition.x )
          ( position.y - model.parentPosition.y )
      in ({ model | position = relativepos } , Cmd.none)
    UpdateParentPosition {top, left} ->
      ({ model | parentPosition = Position top left }, Cmd.none)

port getParentPos : () -> Cmd msg

subscriptions : Model -> Sub Msg
subscriptions model =
  parentPos UpdateParentPosition

port parentPos : ({ top : Int, left : Int } -> msg) -> Sub msg

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        , id "parent"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.position.x)
            , y (toString model.position.y)
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
  on "click"
    (Json.map
      ChangePosition
      (object2
        Position
          (at [ "pageX" ] int)
          (at [ "pageY" ] int)
      )
    )

javascript:

const app = Elm.Main.fullscreen();

app.ports.getParentPos.subscribe(() => {
  const e = document.querySelector('#parent');
  const rect = e.getBoundingClientRect();
  app.ports.parentPos.send({
    top: Math.round(rect.top),
    left: Math.round(rect.left)
  });
});

Answer 2

Here's the fixed version of your example using the VirtualDom. I've upgraded it to elm v0.18 as well. Note just like the accepted answer this just gets the pageX/pageY position and not the relative position. I didn't expand on that.

The relevant changes start at the bottom starting from onClickLocation

import Html exposing (Html, div)
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (..)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)
import VirtualDom

main =
  Html.beginnerProgram
    { model = model
    , view = view
    , update = update
    }

type alias Position =
    { x : Int
    , y : Int
    }

type alias Model =
  Position

type Msg
  = ChangePosition Position

model : Model
model =
  Position 0 0

update : Msg -> Model -> Model
update msg _ =
  case Debug.log "msg" msg of
    ChangePosition position ->
      position

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.x)
            , y "20"
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
    mouseClick ChangePosition


offsetPosition : Json.Decoder Position
offsetPosition =
    Json.map2 Position (field "pageX" Json.int) (field "pageY" Json.int)


mouseEvent : String -> (Position -> msg) -> VirtualDom.Property msg
mouseEvent event messager =
    let
        options =
            { preventDefault = True, stopPropagation = True }
    in
        VirtualDom.onWithOptions event options (Json.map messager offsetPosition)


mouseClick : (Position -> msg) -> VirtualDom.Property msg
mouseClick =
    mouseEvent "click"