この記事はElm+Firebaseでチャットアプリを作るのエントリーです。
前記事 : Elm TDDしながらチャットコメントを実装する
次記事 : Elm TDDしながらelm/timeで日付の変換をする
この記事で行うこと
この記事では、Elmのif式とonClick関数により、チャットコメントの表示と投稿を実装していきます。
実装内容
自分のコメントと他人のコメントを出し分ける
ユーザと名前の頭文字関数の実装
前回の実装ではCommentというレコードに直接名前を持たせていましたが、今回は新しくuidとnameを持ったUserというレコードを定義し、CommentはUserを持つレコードとなりました。名前の頭文字はnameから都度算出すれば良い為、nameInitialという関数を定義しましょう。TDDするため最初は空文字列を返すようにします。また、これらの変更に伴って、コンパイルがエラーになってしまった箇所を修正しておきます。
module Main exposing (Comment, Msg(..), User, chatForm, mediaView)
...
type alias User =
    { uid : Int, name : String }
nameInitial : User -> String
nameInitial { name } =
    ""
type alias Comment =
    { user : User, content : String }
tanaka =
    User 1 "Tanaka Jiro"
suzuki =
    User 2 "Suzuki Taro"
init : () -> ( Model, Cmd Msg )
init _ =
    ( { content = ""
      , comments =
            [ Comment suzuki "Suzukiの1つ目のコメントです。"
            , Comment suzuki "Suzukiの2つ目のコメントです。"
            , Comment tanaka "Tanakaの1つ目のコメントです。"
            , Comment suzuki "Suzukiの3つ目のコメントです。"
            , Comment tanaka "Tanakaの2つ目のコメントです。"
            ]
      }
    , Cmd.none
    )
mediaView : Comment -> Html Msg
mediaView { user, content } =
    div [ class "media" ]
        [ div [ class "media-left" ]
            [ a [ href "#", class "icon-rounded" ] [ text "S" ]
            ]
        , div [ class "media-body" ]
            -- ここが変更
            [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
            , div [] [ text content ]
            ]
        ]
テストケースを追加します。まずは、田中さんの頭文字を言い当てて貰いましょう。
...
  , describe "nameInitial" <|
            let
                tanaka =
                    User 1 "Tanaka Jiro"
                suzuki =
                    User 2 "Suzuki Taro"
            in
            [ test "Tanaka Jiroのイニシャルは「T」だ。" <|
                \_ ->
                    let
                        actual =
                            nameInitial tanaka
                        expect =
                            "T"
                    in
                    Expect.equal expect actual
            ]
空文字なので予想通りREDになりました。
↓ Tests
↓ The Main module
↓ nameInitial
✗ Tanaka Jiroのイニシャルは「T」だ。
    ""
    ╷
    │ Expect.equal
    ╵
    "T"
TEST RUN FAILED
Duration: 159 ms
Passed:   3
Failed:   1
このテストケースをいち早く通すためには、"T"を返すことですね?
nameInitial : User -> String
nameInitial { name } =
    "T"
無事通りました。
Running 4 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 162775159601981 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
TEST RUN PASSED
Duration: 155 ms
Passed:   4
Failed:   0
しかし、鈴木さんは通るでしょうか?
, test "Suzuki Taroのイニシャルは「S」だ。" <|
                \_ ->
                    let
                        actual =
                            nameInitial suzuki
                        expect =
                            "S"
                    in
                    Expect.equal expect actual
もちろん通りません。
Running 5 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 358621588624515 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
↓ Tests
↓ The Main module
↓ nameInitial
✗ Suzuki Taroのイニシャルは「S」だ。
    "T"
    ╷
    │ Expect.equal
    ╵
    "S"
TEST RUN FAILED
Duration: 166 ms
Passed:   4
Failed:   1
田中さんと鈴木さん両方通すには、まともな実装をする必要があります。Stringモジュールに他の言語もお馴染みslice関数があるので、そちらを使いましょう。
nameInitial : User -> String
nameInitial { name } =
    String.slice 0 1 name
無事通ります。TDDでは不安の無くなるまでテストケースを追加しますが、流石に山田さんのテストケースを追加しなくても、そこまで不安はないので2ケースだけにしておきましょう。(空白から始まる人や、そもそも名前がない人も考えられますが、それはUserを生成するときの要素な気がするので、一旦ここはこれで止めておきましょう。)
Running 5 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 223546251984204 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
TEST RUN PASSED
Duration: 159 ms
Passed:   5
Failed:   0
レッド -> グリーン と来たら、リファクタリングです。実装をこれ以上、リファクタリング出来ないように思えます。しかし、テストコードはどうでしょうか?テストコードも立派なリファクタリングの対象になります。重複コードを関数として抽出しましょう。結果とても綺麗なテストの列挙ができるようになりました。テストケースの追加や修正が楽になりましたね?
nameInitialTest : User -> String -> Test
nameInitialTest ({ name } as user) initial =
    test (name ++ "のイニシャルは「" ++ initial ++ "」だ。") <|
        \_ ->
            let
                actual =
                    nameInitial user
                expect =
                    initial
            in
            Expect.equal expect actual
...
, describe "nameInitial" <|
            let
                tanaka =
                    User 1 "Tanaka Jiro"
                suzuki =
                    User 2 "Suzuki Taro"
            in
            [ nameInitialTest tanaka "T"
            , nameInitialTest suzuki "S"
            ]
ユーザの出し分けの実装
ユーザの出し分けを実装していきましょう。自分自身のコメントであれば、右に頭文字のアイコンを持っていき、それ以外のアイコンであれば左にアイコンを持っていきます。まずは関数の型を整えます。自分自身のユーザ情報を各コメントを表示する関数に明示的に渡します。今回は、tanakaさんが自身とします。
...
List.map (mediaView tanaka) comments
                    ++ [ hr [] []
                       , div
                            [ class "media" ]
                            [ div [ class "media-body" ]
                                [ h4 [ class "media-heading" ] [ text "Tanaka Jiro Date:2016/09/01" ]
                                , div [] [ text content ]
                                ]
                            , div
                                [ class "media-right" ]
                                [ a [ href "#", class "icon-rounded" ] [ text "T" ]
                                ]
                            ]
                       ]
...
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    div [ class "media" ]
        [ div [ class "media-left" ]
            [ a [ href "#", class "icon-rounded" ] [ text "S" ]
            ]
        , div [ class "media-body" ]
            [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
            , div [] [ text content ]
            ]
        ]
自身のコメントと他人のコメントが明確に分かるようにテストケースを直します。また、頭文字のアイコンが正しく出るかのテストを追加します。
, describe "mediaView" <|
            let
                tanaka =
                    User 1 "Tanaka Jiro"
                suzuki =
                    User 2 "Suzuki Taro"
                meComment =
                    mediaView tanaka (Comment tanaka "田中のコメントです。")
                otherComment =
                    mediaView tanaka (Comment suzuki "鈴木のコメントです。")
            in
            [ test "コメントしたのは、「Suzuki Taro」だ。" <|
                \_ ->
                    meComment
                        |> Query.fromHtml
                        |> Query.find [ Selector.class "media-body" ]
                        |> Query.find [ Selector.tag "h4" ]
                        |> Query.has [ Selector.text "Tanaka Jiro Date:2018/12/29" ]
            , test "コメント内容は、「コメントです。」だ。" <|
                \_ ->
                    meComment
                        |> Query.fromHtml
                        |> Query.find [ Selector.class "media-body" ]
                        |> Query.find [ Selector.tag "div" ]
                        |> Query.has [ Selector.text "田中のコメントです。"
            , test "Tanakaのコメントのアイコンの頭文字は「T」である。" <|
                \_ ->
                    meComment
                        |> Query.fromHtml
                        |> Query.find [ Selector.class "icon-rounded" ]
                        |> Query.has [ Selector.text "T" ]
            ]
まだ、先程作ったnameInitial関数を使っていないので、前回のままSがベタ打ちされているので、テストは失敗します。
Running 6 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 140550048390734 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
↓ Tests
↓ The Main module
↓ mediaView
✗ Tanakaのコメントのアイコンの頭文字は「T」である。。
    ▼ Query.fromHtml
        <div class="media">
            <div class="media-left">
                <a class="icon-rounded" href="#">
                    S
                </a>
            </div>
            <div class="media-body">
                <h4 class="media-heading">
                    Tanaka Jiro Date:2018/12/29
                </h4>
                <div>
                    田中のコメントです。
                </div>
            </div>
        </div>
    ▼ Query.find [ class "icon-rounded" ]
        1)  <a class="icon-rounded" href="#">
                S
            </a>
    ▼ Query.has [ text "T" ]
    ✗ has text "T"
TEST RUN FAILED
Duration: 156 ms
Passed:   5
Failed:   1
実装は簡単です。nameInitialを呼び出すようにしてあげるだけですね。
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    div [ class "media" ]
        [ div [ class "media-left" ]
            [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
            ]
        , div [ class "media-body" ]
            [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
            , div [] [ text content ]
            ]
        ]
テストは通ります。今回はnameInitialのテストから先にやっているので、テストケースをこれ以上追加する必要はありません。ちゃんとTDDを実践するのであれば、今やっているHtmlのテストが先にレッドになり、いくつかのテストケースを試したいとなってから初めてnameInitial関数を切り出すべきでしょう。let式で定義したローカル関数で済むのであれば、ロジックを近くに寄せておくという点で、それに済むに越したことはありません。
Running 6 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 403969579614899 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
TEST RUN PASSED
Duration: 159 ms
Passed:   6
Failed:   0
テスト対象となるdivタグにmedia-partというクラスを付与して、テストを失敗させるためにmedia-rightを左側(クラスmediaが付与されたdivタグのindex 0 番目の子供)に配置しておきます。(本当はsectionやarticleタグを上手く使いこなして、このような小細工は無くすのが正なのでしょうか。。。)
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    div [ class "media" ]
        [ div [ class "media-right media-part" ]
            [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
            ]
        , div [ class "media-body media-part" ]
            [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
            , div [] [ text content ]
            ]
        ]
テストを追加します。
...
 , test "自身のアイコンは右側に「media-right」のクラスが付くはずだ。" <|
                \_ ->
                    meComment
                        |> Query.fromHtml
                        |> Query.children [ Selector.class "media-part" ]
                        |> Query.index 1
                        |> Query.has [ Selector.class "media-right" ]
index 1 番目には、コメントが来てしまっているのでテストが無事失敗します。
Running 7 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 251614046222391 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
↓ Tests
↓ The Main module
↓ mediaView
✗ 自身のアイコンは右側に「media-right」のクラスが付くはずだ。
    ▼ Query.fromHtml
        <div class="media">
            <div class="media-right media-part">
                <a class="icon-rounded" href="#">
                    T
                </a>
            </div>
            <div class="media-body media-part">
                <h4 class="media-heading">
                    Tanaka Jiro Date:2018/12/29
                </h4>
                <div>
                    田中のコメントです。
                </div>
            </div>
        </div>
    ▼ Query.children [ class "media-part" ]
        1)  <div class="media-right media-part">
                <a class="icon-rounded" href="#">
                    T
                </a>
            </div>
        2)  <div class="media-body media-part">
                <h4 class="media-heading">
                    Tanaka Jiro Date:2018/12/29
                </h4>
                <div>
                    田中のコメントです。
                </div>
            </div>
    ▼ Query.index 1
        1)  <div class="media-body media-part">
                <h4 class="media-heading">
                    Tanaka Jiro Date:2018/12/29
                </h4>
                <div>
                    田中のコメントです。
                </div>
            </div>
    ▼ Query.has [ class "media-right" ]
    ✗ has class "media-right"
TEST RUN FAILED
Duration: 171 ms
Passed:   6
Failed:   1
これをグリーンにするには、とっても簡単です。要素を入れ替えればOKですね?
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    div [ class "media" ]
        [ div [ class "media-body media-part" ]
            [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
            , div [] [ text content ]
            ]
        , div [ class "media-right media-part" ]
            [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
            ]
        ]
テストは通ります。
Running 7 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 68430643028576 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
TEST RUN PASSED
Duration: 157 ms
Passed:   7
Failed:   0
自分以外のコメントは、左側にアイコンが来るはずです。テストを追加します。
, test "自分以外のアイコンは左側に「media-left」のクラスが付くはずだ。" <|
                \_ ->
                    otherComment
                        |> Query.fromHtml
                        |> Query.children [ Selector.class "media-part" ]
                        |> Query.index 0
                        |> Query.has [ Selector.class "media-left" ]
今は、media-rightしか実装していないのでテストは失敗します。
Running 8 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 214739970162009 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
↓ Tests
↓ The Main module
↓ mediaView
✗ 自分以外のアイコンは左側に「media-left」のクラスが付くはずだ。
    ▼ Query.fromHtml
        <div class="media">
            <div class="media-body media-part">
                <h4 class="media-heading">
                    Suzuki Taro Date:2018/12/29
                </h4>
                <div>
                    鈴木のコメントです。
                </div>
            </div>
            <div class="media-right media-part">
                <a class="icon-rounded" href="#">
                    S
                </a>
            </div>
        </div>
    ▼ Query.children [ class "media-part" ]
        1)  <div class="media-body media-part">
                <h4 class="media-heading">
                    Suzuki Taro Date:2018/12/29
                </h4>
                <div>
                    鈴木のコメントです。
                </div>
            </div>
        2)  <div class="media-right media-part">
                <a class="icon-rounded" href="#">
                    S
                </a>
            </div>
    ▼ Query.index 0
        1)  <div class="media-body media-part">
                <h4 class="media-heading">
                    Suzuki Taro Date:2018/12/29
                </h4>
                <div>
                    鈴木のコメントです。
                </div>
            </div>
    ▼ Query.has [ class "media-left" ]
    ✗ has class "media-left"
TEST RUN FAILED
Duration: 164 ms
Passed:   7
Failed:   1
さて出し分けの実装をします。出し分けを考慮した小要素のリストを作るmediaChildrenという名前の変数を定義すれば良さそうです。本来であればid同士を比較すれば良さそうですが、ユーザ名が違うユーザが来ることがあんまり考えられなそうなのと、基本的にElmではすべてのデータ構造が比較可能なので、そのままif式に突っ込んであげます。とりあえずベタッと要素を左と右入れ替えて、media-rightとmedia-leftに変えたリストを用意してあげたら最低限の実装のような気がします。
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    let
        mediaChildren =
            if user == me then
                [ div [ class "media-body media-part" ]
                    [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
                    , div [] [ text content ]
                    ]
                , div [ class "media-right media-part" ]
                    [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
                    ]
                ]
            else
                [ div [ class "media-left media-part" ]
                    [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
                    ]
                , div [ class "media-body media-part" ]
                    [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
                    , div [] [ text content ]
                    ]
                ]
    in
    div [ class "media" ] mediaChildren
無事テストが通りました。
Running 8 tests. To reproduce these results, run: elm-test --fuzz 100 --seed 66773586332653 /Users/mirai.watanabe/Desktop/elm-firebase-chat/tests/Tests.elm
TEST RUN PASSED
Duration: 163 ms
Passed:   8
Failed:   0
レッド -> グリーン と来たら・・・リファクタリングです!今回は実装をDRYに出来そうな箇所があるので、直しておきました。これで、コメント本体に変更があっても一箇所で済みそうです。アイコンに関しても頑張れば良い感じなコードが書けそうな気がしますが、あんまり頑張り過ぎても逆に変更が難しいコードになってしまったり、ここにコストを掛けてもリターンは少なそうです。何よりもテストで安全は保証されているので、いつでもコードのリファクタリングはできるのです!程々に留めておきましょう。
mediaView : User -> Comment -> Html Msg
mediaView me { user, content } =
    let
        mediaBody =
            div [ class "media-body media-part" ]
                [ h4 [ class "media-heading" ] [ text <| user.name ++ " Date:2018/12/29" ]
                , div [] [ text content ]
                ]
        mediaChildren =
            if user == me then
                [ mediaBody
                , div [ class "media-right media-part" ]
                    [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
                    ]
                ]
            else
                [ div [ class "media-left media-part" ]
                    [ a [ href "#", class "icon-rounded" ] [ text <| nameInitial user ]
                    ]
                , mediaBody
                ]
    in
    div [ class "media" ] mediaChildren
見た目と次の実装の準備をします。実は黙っていたのですが、Elmでリストで要素を追加するときには、(線形リストなので)先頭に要素を追加する方が効率的だったりします。そのため表示するときには、逆転させてあげる必要があるので、reverse関数を差し込んであげましょう。あとはコメント毎に罫線を入れるように、あまり見慣れないかもしれませんintersperse関数を使います。本当はこのviewに関してもテストを書ける気もしますが、revese, map, intersperseのようにリストの一般的な関数を組み合わせているに過ぎないので、テストは不要と判断しました。(中身については切り出して、その部分にテストをしているため)
...
   , div [ class "card-body" ] <|
                (comments |> List.reverse |> List.map (mediaView me) |> List.intersperse (hr [] []))
            ]
        , section [ class "page-footer" ]
            [ chatForm content
            ]
...
コメントの追加の実装
コメントの追加について実装をします。前回実装したonInputの実装とそこまで変わらないので、実装をベターッと貼ってテストは書かずにフィニッシュとします。
import Html.Attributes exposing (class, href, placeholder, type_, value)
import Html.Events exposing (onClick, onInput)
type alias Model =
    { me : User, content : String, comments : List Comment }
-- commentsは逆になりました。
init : () -> ( Model, Cmd Msg )
init _ =
    ( { me = tanaka
      , content = ""
      , comments =
            [ Comment tanaka "Tanakaの2つ目のコメントです。"
            , Comment suzuki "Suzukiの3つ目のコメントです。"
            , Comment tanaka "Tanakaの1つ目のコメントです。"
            , Comment suzuki "Suzukiの2つ目のコメントです。"
            , Comment suzuki "Suzukiの1つ目のコメントです。"
            ]
      }
    , Cmd.none
    )
type Msg
    = UpdateContent String
    | SendContent
update : Msg -> Model -> ( Model, Cmd Msg )
update msg ({ me, content, comments } as model) =
    case msg of
        UpdateContent c ->
            ( { model | content = c }, Cmd.none )
        SendContent ->
            if String.isEmpty (String.trim content) then
                ( model, Cmd.none )
            else
                ( { model
                    | comments = Comment me content :: comments
                    , content = ""
                  }
                , Cmd.none
                )
chatForm : String -> Html Msg
chatForm content =
    div [ class "chart-form pure-form" ]
        [ div [ class "input-group" ]
            [ input [ type_ "text", value content, placeholder "Comment", onInput UpdateContent ] []
            , button [ class "pure-button button-secondary", onClick SendContent ] [ text "SNED" ]
            ]
        ]
・・・と言いたいところですが、自分自身がテストを書かない実装をすることでバグを発生させてしまったので、テストを書くことが正義だと悟りました・・・。TDDではありませんが、後付の贖罪テストのコードを載せておきます。
update : Msg -> Model -> ( Model, Cmd Msg )
update msg ({ me, content, comments } as model) =
    case msg of
        UpdateContent c ->
            ( { model | content = c }, Cmd.none )
        SendContent ->
            ( updateSendContent model, Cmd.none )
updateSendContent : Model -> Model
updateSendContent ({ me, content, comments } as model) =
    if String.isEmpty (String.trim content) then
        model
    else
        { model
            | comments = Comment me content :: comments
            , content = ""
        }
, test "SENDボタンを押したら、SendContent Msgが発行される" <|
               \_ ->
                   chatForm ""
                       |> Query.fromHtml
                       |> Query.find [ Selector.tag "button" ]
                       |> Event.simulate Event.click
                       |> Event.expect SendContent
           ]
, describe "updateSendContent" <|
            let
                tanaka =
                    User 1 "Tanaka Jiro"
                suzuki =
                    User 2 "Suzuki Taro"
            in
            [ test "打たれている内容が空の場合、コメント反映はされない。" <|
                \_ ->
                    let
                        actual =
                            updateSendContent <| Model tanaka "" []
                        expect =
                            Model tanaka "" []
                    in
                    Expect.equal expect actual
            , test "打たれている内容が空ではない場合、コメントはリストの先頭に追加され、内容は空になる。" <|
                \_ ->
                    let
                        actual =
                            updateSendContent <|
                                Model tanaka
                                    "second"
                                    [ Comment suzuki "first"
                                    ]
                        expect =
                            Model tanaka
                                ""
                                [ Comment tanaka "second"
                                , Comment suzuki "first"
                                ]
                    in
                    Expect.equal expect actual
            ]
実行結果
ソースコード
この時点でのソースコード

