如何在 Elm 中处理来自递归 HTML UI 的消息？

Question

我正在尝试构建一个允许用户操作递归数据结构的 UI。例如，想象一个可视化模式编辑器或数据库表编辑器，其中有普通的旧类型（字符串和整数）和由这些普通类型（数组、结构）组成的复合类型。在下面的示例中，Struct_ 类似于 JavaScript 对象，其中键是字符串，值是任意类型，包括嵌套的 Array_s 和 Struct_s。

-- underscores appended to prevent confusion about native Elm types. These are custom to my application.
type ValueType
    = String_
    | Int_
    | Float_
    | Array_ ValueType
    | Struct_ (List (String, ValueType))

type alias Field =
    { id : Int
    , label : String
    , hint : String
    , hidden : Bool
    , valueType : ValueType
    }

type alias Schema = List Field

现在要为此构建一个 UI，我可以创建一个简单的递归函数：

viewField : Field -> Html Msg
viewField field =
    div []
    [ input [ type_ "text", value field.label ] []
    , viewValueType field.valueType
    ]

viewValueType : ValueType -> Html Msg
viewValueType valueType =
    let
        structField : (String, ValueType) -> Html Msg
        structField (key, subtype) =
            div []
                [ input [type_ "text", placeholder "Key", value key, onInput EditStructSubfieldKey] []
                , viewValueType subtype
                ]

        options : List(Html Msg)
        options = case valueType of
            String_ -> -- string ui
            Int_ -> -- int ui
            Float_ -> -- float ui
            Array_ subtype ->
                [ label [] [ text "subtype" ]
                , viewValueType subtype
                ]
            Struct_ fields ->
                [ label [] [ text "subfields" ]
                , List.map structField fields
                , button [ onClick AddStructSubfield ] [ text "Add subfield" ]
                ]
    in
    div [] options

我的问题是在尝试使用这种递归结构来操纵我的状态时出现的。 Msgs 中的什么数据结构可以容纳用户对此结构的编辑、添加新字段、子字段以及编辑它们的属性？如何在我的 update 循环中正确解码？

例如...

type alias Model =
    { fields : List Field }

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        AddStructSubfield _???_ ->
            ({model | fields = ???}, Cmd.none)
        EditStructSubfieldKey _???_ ->
            ({model | fields = ???}, Cmd.none)

您将向AddStructSubfield 或EditStructSubfieldKey 消息附加什么样的数据（通过onClick 处理程序传递给上面的button）以正确更新您的状态，特别是当Struct_ 是说，嵌套在另一个 Struct_ 中，嵌套在 Array_ 中？例如，EditStructSubfieldKey 将只包含用户输入的新字符串，但没有足够的信息来处理深层嵌套的项目。

Answer 1

我们在代码库中正是这样做的，但尚未开源支持这一点的“库”。但您的问题的答案是您需要在代码和消息中添加 Path 的概念。

type Path 
    = Field: String 
    | Index: Int 

然后你的视图必须在你下降[Field "f1", Index 3, ...]时不断更新路径，并且你的更新功能需要被插入、删除、...支持，它们采用路径和现有结构并返回一个新结构。

Answer 2

我最终通过在递归链中传递一个更新函数来解决这个问题。我已经尽可能简化了这个例子，同时展示了更新的递归性质。这允许更新无限嵌套的结构和列表，而无需担心编码/解码路径。我相信，缺点是我的单一更新Msg 将始终替换整个模型。我不确定这将如何影响 Elm 的相等性检查的语义，以及这是否会在某些应用程序中产生性能问题。

可以将这个示例复制/粘贴到https://elm-lang.org/try 中以查看它的实际效果。

import Html exposing (Html, div, input, ul, li, text, select, button, option)
import Html.Attributes exposing (value, type_, selected)
import Html.Events exposing (onInput, onClick)
import Browser

type ValueType
    = String_
    | Int_
    | Array_ ValueType
    | Struct_ (List Field)

type alias Field =
    { label : String
    , valueType : ValueType
    }

type alias Model = Field

main = Browser.sandbox { init = init, update = update, view = view }

init : Model
init =
    { label = "Root Field", valueType = String_ }

type Msg
    = UpdateField Field

update : Msg -> Model -> Model
update msg model =
    case msg of
        UpdateField field ->
            field

view : Model -> Html Msg
view model =
    let
        updater : Field -> Msg
        updater field =
            UpdateField field
    in
    div [] [ viewField updater model ]

viewField : (Field -> Msg) -> Field -> Html Msg
viewField updater field =
    let
        updateLabel : String -> Msg
        updateLabel newLabel =
            updater {field | label = newLabel}

        updateValueType : ValueType -> Msg
        updateValueType newValueType =
            updater {field | valueType = newValueType}
    in
    li []
    [ input [ type_ "text", value field.label, onInput updateLabel ] [ ]
    , viewTypeOptions updateValueType field.valueType
    ]

viewTypeOptions : (ValueType -> Msg) -> ValueType -> Html Msg
viewTypeOptions updater valueType =
    let
        typeOptions = case valueType of
            String_ ->
                div [] []
            Int_ ->
                div [] []
            Array_ subtype ->
                let
                    subUpdater : ValueType -> Msg
                    subUpdater newType =
                        updater <| Array_ newType
                in
                div [] [ div [] [ text "Subtype" ], viewTypeOptions subUpdater subtype ]
            Struct_ fields ->
                let
                    fieldAdder : Msg
                    fieldAdder =
                        updater <| Struct_ ({label = "", valueType = String_} :: fields)

                    fieldUpdater : Int -> Field -> Msg
                    fieldUpdater index newField =
                         updater <| Struct_ <| replaceInList index newField fields
                in
                div []
                  [ ul [] (List.indexedMap (\i -> (viewField <| fieldUpdater i)) fields)
                  , button [ onClick fieldAdder ] [ text "+ Add Field" ]
                  ]

        isArray t = case t of
            Array_ _ -> True
            _ -> False

        isStruct t = case t of
            Struct_ _ -> True
            _ -> False

        stringToType str = case str of
            "string" -> String_
            "int" -> Int_
            "array" -> Array_ String_
            "struct" -> Struct_ []
            _ -> String_

        changeType str =
            updater <| stringToType str

    in
    div []
    [ select [ onInput changeType ]
        [ option [ value "string", selected <| valueType == String_ ] [ text "String" ]
        , option [ value "int", selected <| valueType == Int_ ] [ text "Integer" ]
        , option [ value "array", selected <| isArray valueType ] [ text "Array" ]
        , option [ value "struct", selected <| isStruct valueType ] [ text "Struct" ]
        ]
    , typeOptions
    ]

replaceInList : Int -> a -> List a -> List a
replaceInList index item list =
    let
        head = List.take index list
        tail = List.drop (index+1) list
    in
    head ++ [ item ] ++ tail