Assigning Unique Callback Functions in Elm - function

Question

I am trying to make a simple Elm webapp that lets me add rectangles to an SVG canvas and drag them around. However, I am running into problems trying to programmatically differentiate the rectangle click handlers. The below code works fine for a single rectangle (mousedown on the shape and move around and it will drag correctly). However, every further rectangle generated somehow has its mousedown function also specifying the first rectangle.
This creates the rectangle with rectID and (I thought) would also create a unique partial function of customOnMouseDown with the rectID parameter of this rectangle.
NewRect rectId ->
let
newRect =
Rect (customOnMouseDown (String.fromInt rectId)) (String.fromInt rectId)
(rectId) 0 20 20
in
( { model |
rects = newRect :: model.rects
, count = model.count + 1}
, Cmd.none)
After trying several different formulations, I think my mental model of Elm's runtime is wrong, so I would like to not only know the correct way to do this sort of thing but also why this way isn't working, if possible.
Full code:
import Browser
import Browser.Events
import Html exposing (..)
import Html.Events
import Task
import Time
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Events exposing (..)
import Random
import Json.Decode as D
-- MAIN
-- main =
main =
Browser.element
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ drag : Maybe Drag
, pos : Position
, rects : List Rect
, selected : String
, count : Int
}
type alias Position =
{ x: Int
, y: Int
}
type alias Drag =
{ startPos : Position
, currentPos : Position
}
type alias Rect =
{ mouseDown : Html.Attribute Msg
, rectId : String
, x : Int
, y : Int
, width : Int
, height : Int
}
init : () -> (Model, Cmd Msg)
init _ =
( Model Nothing (Position 0 0) [] "" 0
, Cmd.none
)
-- UPDATE
type Msg
= Press Position String
| Release Position
| Move Position
| AddRect
| NewRect Int
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
Press pos rectId ->
({model | drag = Just (Drag pos pos)
, selected = rectId
}
, Cmd.none)
Release pos ->
({ model | drag = Nothing, selected = ""}, Cmd.none)
Move pos ->
( { model |
rects =
case (getRect model.selected model.rects) of
Nothing -> model.rects
Just r ->
(Rect r.mouseDown r.rectId pos.x pos.y 20 20)::(dropRect r.rectId model.rects)
}
, Cmd.none )
AddRect ->
( model
, Random.generate NewRect (Random.int 1 1000)
)
NewRect rectId ->
let
newRect =
Rect (customOnMouseDown (String.fromInt rectId)) (String.fromInt rectId)
(rectId) 0 20 20
in
( { model |
rects = newRect :: model.rects
, count = model.count + 1}
, Cmd.none)
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model.drag of
Nothing ->
Sub.none
Just _ ->
Sub.batch [ Browser.Events.onMouseMove mouseMoveDecoder
, Browser.Events.onMouseUp mouseReleaseDecoder ]
mouseMoveDecoder : D.Decoder Msg
mouseMoveDecoder =
D.map Move mouseCoordDecoder
mouseReleaseDecoder : D.Decoder Msg
mouseReleaseDecoder =
D.map Release mouseCoordDecoder
mouseCoordDecoder : D.Decoder Position
mouseCoordDecoder =
D.map2 Position
(D.field "x" D.int)
(D.field "y" D.int)
-- VIEW
view : Model -> Html Msg
view model =
let
total_width = "1000"
total_height = "500"
in
div []
[ svg
[ width total_width
, height total_height
, viewBox ("0 0 " ++ total_width ++ total_height)
]
(renderShape model.rects)
, div [] [ div [] [ Html.text (String.fromInt model.pos.x) ]
, div [] [ Html.text (String.fromInt model.pos.y) ]
, div [] [ Html.text model.selected ]
, div [] [ Html.text (String.fromInt (List.length model.rects)) ]
, div [] [ (renderList (List.map .rectId model.rects)) ]
, button [ onClick AddRect ] [ Html.text "Rect" ] ]
]
renderList : List String -> Html msg
renderList lst =
ul []
(List.map (\l -> li [] [ Html.text l ]) lst)
customOnMouseDown : String -> (Html.Attribute Msg)
customOnMouseDown shapeIndex =
let
decoder =
D.oneOf
[ D.map2
Press
( D.map2
Position
( D.field "pageX" D.int)
( D.field "pageY" D.int)
)
(D.succeed ( shapeIndex ))
, D.succeed (Press ( Position 500 500 ) shapeIndex )
]
in
Html.Events.on "mousedown" decoder
extractRect : Rect -> Svg Msg
extractRect r =
rect [ r.mouseDown
, x (String.fromInt r.x)
, y (String.fromInt r.y)
, width (String.fromInt r.width)
, height (String.fromInt r.height)
]
[]
renderShape : List Rect -> List (Svg Msg)
renderShape lst =
List.map extractRect lst
rectIdMatch : String -> Rect -> Bool
rectIdMatch target rect = target == rect.rectId
getRect : String -> List Rect -> (Maybe Rect)
getRect target lst =
List.head (List.filter (rectIdMatch target) lst)
dropRect : String -> List Rect -> List Rect
dropRect target lst =
case lst of
[] -> []
[x] ->
if x.rectId == target then
[]
else
[]
x::xs ->
if x.rectId == target then
xs
else
x::(dropRect target xs)

Answer 1

Per glennsl https://ellie-app.com/76K6JmDJg4Fa1]1
Changing the JSON decoder seemed to fix the issue, although I'm not sure why
customOnMouseDown : String -> (Html.Attribute Msg)
customOnMouseDown shapeIndex =
let
decoder =
D.oneOf
[ D.map2
Press
( D.map2
Position
( D.field "pageX" D.int)
( D.field "pageY" D.int)
)
(D.succeed ( shapeIndex ))
, D.succeed (Press ( Position 500 500 ) shapeIndex )
]
in
Html.Events.on "mousedown" decode