How to create a Task with messages that require payload in Elm?

Question

Sorry about the imprecise question title. Could not quite pinpoint the problem in question.

I'm trying to use "translator pattern" mentioned in this great blog post by Alex Lew here: The Translator Pattern: a model for Child-to-Parent Communication in Elm.

But being a total Elm newbie I don't quite get it in the following situation:

I have a module like this (child component in the pattern):

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
        }

The problem is the registerUser function which obviously does not work as it is now. I can't get it to return Cmd Msg. I can make like so that it return Cmd InternalMsg but then of course I run into problems in update functions Register message. There I would need to convert Cmd InternalMsg to Cmd Msg.

I've tried to solve this in both places but always come up short. There is most likely a simple solution to this but alas no skills to do that as it seems.

Any help would be much appreciated.

Answer 1

That is an ugly part of Translator pattern, you should Cmd.map your Command to the Msg Message, so instead of:

Task.perform ForSelf RegisterFail  ForSelf RegisterSucceed postRequest 

You should have something like:

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