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

How to handle messages from recursive HTML UI in Elm?

我正在尝试构建一个允许用户操作递归数据结构的 UI。例如,想象一个可视化模式编辑器或数据库 table 编辑器,其中有普通的旧类型(字符串和整数)和由这些普通类型(数组、结构)组成的复合类型。在下面的示例中,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)

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

我们在我们的代码库中正是这样做的,但还没有开源支持它的 'library'。但是你的问题的答案是你需要在代码和消息中添加 Path 的概念。

type Path 
    = Field: String 
    | Index: Int 

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

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

此示例可以按原样 copy/pasted 转换为 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