在Elm中分配唯一的回调函数

Question

我正在尝试制作一个简单的Elm Webapp，该应用程序允许我将矩形添加到SVG画布并将其拖动。但是，我在尝试以编程方式区分矩形单击处理程序时遇到问题。下面的代码对于单个矩形可以正常工作（在形状上向下移动鼠标并四处移动，它将正确拖动）。但是，每个生成的其他矩形都有其鼠标按下功能also指定第一个矩形。

这将创建具有rectID的矩形，并且（我认为）还将创建具有this矩形的rectID参数的customOnMouseDown的unique部分函数。

    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)

[尝试了几种不同的公式后，我认为我对Elm运行时的思维模型是错误的，所以我不仅想知道做这种事情的正确方法，而且想知道为什么这种方法不可行。

完整代码：

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 glennslhttps://ellie-app.com/76K6JmDJg4Fa1]1

更改JSON解码器似乎可以解决该问题，尽管我不确定为什么

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