Cat Racing summary of Part II

cat-racing.elm

module Main exposing (..)

import Html exposing (button, div, form, input, label, program, text)
import Html.Attributes exposing (type_)
import Html.Events exposing (onInput, onSubmit)
import Http
import Json.Decode exposing (Decoder)
import Json.Encode


type alias Cat =
    { name : String
    , id : Maybe String
    , score : Maybe Int
    }


type alias Model =
    { cat : Cat
    }


view : Model -> Html.Html Message
view model =
    form []
        [ div [ onSubmit <| SaveChanges model.cat ]
            [ label [] [ text "Name" ]
            , input [ onInput ChangeName ] []
            ]
        , div []
            [ label [] [ text "Score" ]
            ]
        , div []
            [ button [ type_ "submit" ] [ text "Update" ]
            ]
        , div [] [ text <| toString model.cat ]
        ]


type Message
    = ChangeName String
    | SaveChanges Cat
    | UpdateSucceeded Cat
    | UpdateFailed Http.Error


update : Message -> Model -> ( Model, Cmd Message )
update msg model =
    case msg of
        ChangeName newName ->
            ( { model | cat = setName newName model.cat }, Cmd.none )

        SaveChanges cat ->
            ( model, sendUpdateRequest cat )

        UpdateFailed error ->
            Debug.log ("Update Failed " ++ (toString error)) ( model, Cmd.none )

        UpdateSucceeded newCat ->
            ( { model | cat = newCat }, Cmd.none )


setName : String -> Cat -> Cat
setName newName cat =
    { cat | name = newName }


sendUpdateRequest : Cat -> Cmd Message
sendUpdateRequest cat =
    Http.send createMessage <|
        Http.post "/cats" (createBody cat) decodeResponse


createMessage : Result Http.Error Cat -> Message
createMessage result =
    case result of
        Ok cat ->
            UpdateSucceeded cat

        Err error ->
            UpdateFailed error


createBody : Cat -> Http.Body
createBody cat =
    Http.jsonBody <|
        Json.Encode.object
            [ ( "name", Json.Encode.string cat.name )
            , ( "id", Maybe.withDefault Json.Encode.null <| Maybe.map Json.Encode.string <| cat.id )
            , ( "score", Maybe.withDefault Json.Encode.null <| Maybe.map Json.Encode.int <| cat.score )
            ]


decodeResponse : Decoder Cat
decodeResponse =
    Json.Decode.map3 Cat
        (Json.Decode.field "name" Json.Decode.string)
        (Json.Decode.field "score" <| Json.Decode.maybe Json.Decode.int)
        (Json.Decode.field "id" <| Json.Decode.maybe Json.Decode.string)


main =
    program
        { view = view
        , update = update
        , subscriptions = Sub.none
        , init = ( initModel, Cmd.none )
        }


initModel =
    { cat = { name = "", id = Nothing, score = Nothing } }