如何在Elm中创建带有payload的消息任务?

5

抱歉标题不够准确,无法确定问题所在。

我正在尝试使用Alex Lew在这篇极好的博客文章中提到的“翻译器模式”:Elm中子组件向父组件通信的模型

但由于我是完全的Elm新手,在以下情况下并不理解:

我有一个像这样的模块(在该模式中为子组件):

module Pages.SignUp.Update exposing (update, Msg(..))
import Http
import HttpBuilder exposing (withHeader, withJsonBody, stringReader, jsonReader, send)
import Task exposing (Task)
import Json.Decode exposing (Decoder, bool, (:=))
import Json.Encode exposing (encode, object, string)
import String
import Update.Extra exposing (andThen)
import Debug


type alias Model =
    { displayName : String
    , displayNameErrors : List (Maybe String)
    , email : String
    , emailErrors : List  (Maybe String)
    , password : String
    , passwordConfirmation : String
    , passwordErrors : List (Maybe String)
    , modelValid : Bool
    , emailValidationPending : Bool
    , registrationPending : Bool }


emptyModel :  Model
emptyModel =
    { displayName = ""
    , displayNameErrors = []
    , email = ""
    , emailErrors = []
    , password = ""
    , passwordConfirmation = ""
    , passwordErrors = []
    , modelValid = False
    , emailValidationPending = False
    , registrationPending = False }

type InternalMsg
    = SetEmail String
    | SetDisplayName String
    | SetPassword String
    | SetPasswordConfirm String
    | Register
    | RegisterSucceed (HttpBuilder.Response Bool)
    | RegisterFail (HttpBuilder.Error String)
    | ValidateModel
    | Noop

type OutMsg 
    = UserRegistered

type Msg 
    = ForSelf InternalMsg
    | ForParent OutMsg

type alias TranslationDictionary msg =
    { onInternalMessage: InternalMsg -> msg
    , onUserRegistered: msg
    }

type alias Translator msg =
    Msg -> msg


translator : TranslationDictionary msg -> Translator msg
translator { onInternalMessage, onUserRegistered } msg =
    case msg of
        ForSelf internal ->
            onInternalMessage internal
        ForParent UserRegistered ->
            onUserRegistered 

never : Never -> a
never n =
    never n

generateParentMessage : OutMsg -> Cmd Msg
generateParentMessage outMsg =
    Task.perform never ForParent (Task.succeed outMsg )

init : ( Model, List Notification )
init =
    ( emptyModel, [] )

update : InternalMsg -> Model -> (Model, Cmd Msg)

update  msg model =
    case Debug.log "Signup action" msg of
        SetEmail emailStr ->
            let model' =
                {model | email = emailStr }
            in
                 update ValidateModel model'

        SetDisplayName nameStr ->
            let model' = 
                { model | displayName = nameStr }
            in
                update ValidateModel model'

        SetPassword passwordStr ->
            let model' =
                { model | password = passwordStr }
            in
                update ValidateModel model'

        SetPasswordConfirm passwordConfirmStr ->
        let model' = 
            { model | passwordConfirmation = passwordConfirmStr }
        in 
            update ValidateModel model'

        ValidateModel ->
            let validatedModel =
                    validateModel model
                test = Debug.log "validated model" validatedModel
            in
                ( validatedModel, Cmd.none )

        Register ->
            ( { model | registrationPending = True }, registerUser model)

        RegisterSucceed _ -> 
            ( { model | registrationPending = False }, (generateParentMessage UserRegistered) )

        RegisterFail  error ->
            case  error of
                HttpBuilder.BadResponse response ->
                    case Debug.log "Register response status" response.status of
                        422 -> 
                            ( { model | registrationPending = False }, Cmd.none )
                        _ ->
                            ( { model | registrationPending = False }, Cmd.none )
                _ ->
                    ( { model | registrationPending = False }, Cmd.none)
        Noop ->
            (model, Cmd.none)


registerUser : Model -> Cmd Msg
registerUser model =
    let url = 
            "/api/users"

        user =
            object [
                ("user",
                    object
                    [
                        ("display_name", (string model.displayName)),
                        ("email", (string model.email)),
                        ("password", (string model.password)),
                        ("passwordConfirmation", (string model.passwordConfirmation))
                    ]
                )
            ]

        postRequest =
            HttpBuilder.post url
            |> withHeader "Content-type" "application/json"
            |> withJsonBody user
            |> send (jsonReader decodeRegisterResponse) stringReader
    in
        Task.perform ForSelf RegisterFail  ForSelf RegisterSucceed postRequest 

decodeRegisterResponse : Decoder Bool
decodeRegisterResponse = 
        "ok" := bool

validateRequired : String -> String -> Maybe String

validateRequired fieldContent fieldName =
            case String.isEmpty fieldContent of 
                True -> Just <| String.join " " [ fieldName, "required" ]
                False ->  Nothing

validateEmail : String -> List (Maybe String)

validateEmail email =
    let requiredResult = 
            validateRequired email "Email"
    in
        [requiredResult]

validatePassword : String -> String -> List (Maybe String) 
validatePassword password passwordConf =
    let requiredResult =
             validateRequired password "Password"
        confirmResult =
            case password == passwordConf of
                True -> Nothing
                False ->  Just "Password confirmation does not match"
    in
        [ requiredResult, confirmResult ] 

validateModel : Model -> Model
validateModel model =
    let emailResult =
            validateEmail model.email
        displayNameResult =
            validateRequired model.displayName "Displayname" :: []
        passwordResult =
            validatePassword model.password model.passwordConfirmation
        errors =
            List.concat [emailResult,  displayNameResult, passwordResult ] |> List.filterMap identity
        modelValid = List.isEmpty errors
    in
        { model | 
            emailErrors = emailResult,
            displayNameErrors = displayNameResult,
            passwordErrors = passwordResult,
            modelValid = modelValid
        }

问题出在registerUser函数上,目前它显然不能正常工作。我无法使其返回Cmd Msg。我可以使它返回Cmd InternalMsg,但是这样会导致在update函数中的Register消息出现问题。在那里,我需要将Cmd InternalMsg转换为Cmd Msg。
我尝试在两个位置都解决了这个问题,但总是失败。这很可能有一个简单的解决方案,但似乎没有技能来实现它。
非常感谢您的任何帮助。

1
这只是一个猜测,但你是否尝试过Cmd.map ForSelf : Cmd InternalMsg -> Cmd Msg - Lynn
1个回答

7

这是翻译器模式的一个不太好的部分,你应该将你的命令Cmd.mapMsg消息中,所以不要写成:

Task.perform ForSelf RegisterFail  ForSelf RegisterSucceed postRequest 

你应该有以下这样的东西:
Cmd.map ForSelf (Task.perform RegisterFail RegisterSucceed postRequest)

如果您不喜欢在这里使用 Cmd.map,为什么不改用 Task.perform (ForSelf << RegisterFail) (ForSelf << RegisterSucceed) postRequest 呢? - Zimm i48
@Zimmi48 函数组合运算符对于新手来说是令人困惑的,我不建议使用它们。丑陋的部分是这种额外的复杂性,而不是 Cmd.map - halfzebra
我不同意。函数组合是任何学过高中数学的人都知道的概念。在这种情况下使用它的优点是可以确定错误出在哪里(给Task.perform提供了5个参数而不仅仅是三个)。 - Zimm i48

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接