如何使用Elm中需要有效负载的消息创建任务?

时间:2016-08-03 10:15:45

标签: elm

对于不精确的问题标题感到抱歉。无法确定问题所在。

我正在尝试使用Alex Lew撰写的这篇精彩博文中提到的“翻译模式”:The Translator Pattern: a model for Child-to-Parent Communication in 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但当然我遇到更新函数注册消息中的问题。在那里,我需要将Cmd InternalMsg转换为Cmd Msg。

我试图在两个地方解决这个问题,但总是很短暂。很可能是一个简单的解决方案,但似乎没有技能可以做到这一点。

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:7)

这是翻译模式的一个丑陋部分,你应该Cmd.map你的Msg消息的命令,所以而不是:

Task.perform ForSelf RegisterFail  ForSelf RegisterSucceed postRequest 

你应该有类似的东西:

Cmd.map ForSelf (Task.perform RegisterFail RegisterSucceed postRequest)