Elm

Elmで非同期Http通信を含んだSPAを試してみる

 ElmでSPA(Single Page Application)を行うときは、NavigationとUrlParserが使われます。しかし現実的には、SPAを実現するときにはサーバからデータを取得する必要があります。これは非同期のTask処理が必要になるので、単にNavigationとUrlParserを使う以上に、複雑になります。今回はサンプルプログラムを作りましたので、説明していきたいと思います。

 しかしこれまでいろいろElmを触ってきましたが、最初は良いところだけが見えていたのに、足りないところも見えてきました。私はプログラムに可読性を強く求めたいので、その辺ですかね。Json.Decodeとかごちゃごちゃしちゃって。Elmは富士山かサイコパスか。まあそれでもAlt JavaScriptで純粋関数型であるだけで、大変魅力的なのですが。

1.準備

 まず環境の整備を行います(私はCeontos7で行っています)。以下のパッケージをインストールしておきます。

elm-package install elm-lang/http
elm-package install elm-lang/navigation
elm-package install evancz/url-parser

 次にRest APIのモック環境を作るためにjson-serverをインストールします。

npm install -g json-server  

 json-sserverに食わせるためのデータを用意します。

{
 "tags": { "animals": ["猫","犬","クジラ","ヤギ","タカ"] }
,"articles": [ 
  { "id":1, "title": "12月29日 晴れ", "story": "今日は晴れでした。"}
, { "id":2, "title": "12月30日 曇り", "story": "今日は大掃除をしました。エアコンの掃除は大変でした。"}
, { "id":3, "title": "12月31日 晴れのち雨", "story": "今日は大晦日です。夜更かしします。"}
   ]
}

 json-serverは以下のコマンドで起動します。

json-server db.json --port 3090 

2.データの設計

 まずデータの設計を行います。Modelを以下のように定義します。サーバからtagsとarticlesの2種類のデータを取ってきますので、それぞれTagとArticleという型を定義します。pageにはRoute情報を入れますが、これでview関数にどのページを描画すればよいのかを教えます。
 loadingは、リンクがクリックされたときにRoute情報を保存しておき、非同期通信がCompleteしたときにpageを上書きするためのものです。view関数はpageだけを見ていてloadingは見ていません。データ取得が完了したときにpageが更新されますので、この時に初めて画面が遷移します。また後で説明します。

Model
type Tag
    = Tag String

type alias Article =
    { story : String
    , title : String
    }

type alias Model =
  { loading : Maybe Route
  , page : Maybe Route
  , tags : List Tag
  , articles : List Article
  }

3.routeの定義

 SPAの肝となるrouteの定義を行います。これにはUrlParserを使います。このパッケージはElm作者自身が作成してくれたものです。

Route
type Route
  = RouteHome
  | RouteTags
  | RouteArticles
  | RouteArticlePost Int
  | RouteTagsArticles
  | RouteMain

route : Url.Parser (Route -> a) a
route =
  Url.oneOf
    [ Url.map RouteHome top
    , Url.map RouteTags (Url.s "tags")
    , Url.map RouteArticles (Url.s "articles")
    , Url.map RouteArticlePost (Url.s "articles" </> int)
    , Url.map RouteTagsArticles (Url.s "tags-articles")
    , Url.map RouteMain (Url.s "Main.elm")
    ]

 UrlParserはpath文字列をElm値に変換するためのものです。ここでの変換定義は直感的に以下のように読み取ることができます。このように宣言的に定義できるところはElmやHaskellなどの関数型言語の大変優れているところだと思います。

"/"               --> RouteHome
"/tags/"          --> RouteTags
"/articles/"      --> RouteArticles
"/tags/3"         --> RouteArticlePost 3
"/tags-articles/" --> RouteTagsArticles
"/Main.elm/"      --> RouteMain

 このようにして得られたElm値(Route情報)は、View関数においてどの画面を描画するかを決めるために使われます。

 ちなみに"/Main.elm/"は最初に本アプリをブラウザにロードした時のURL(path)です。初期画面になります。

 UrlParserについては以上が全てですが、必要に応じて以下の記事も併せてお読みください。
ElmのSPAとRouting - Qiita

4.update関数

 ElmはイベントドリブンというよりはMsgドリブンです。Msgが生成するとupdate関数が呼ばれmodelを更新し、そのmodelの変化を伝えるためにview関数が呼ばれます。この繰り返しで全体の処理が進んでいきます。以下に説明をしていきます。

update
type Msg
  = MsgNewUrl String
  | MsgUrlChange Navigation.Location
  | MsgNewTags (Result Http.Error (List Tag))
  | MsgNewArticles (Result Http.Error (List Article))
  | MsgNewTagsArticles (Result Http.Error (List Tag, List Article) )
  | MsgNewArticlePost (Result Http.Error Article)


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
  case msg of
    MsgNewUrl url ->
      ( model
       ,Navigation.newUrl url
      )

    MsgUrlChange location ->
      let
        _ = Debug.log "location=" location
        newpage = Url.parsePath route location
      in
        case newpage of
            Nothing ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteHome ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteTags ->
                ( { model | loading = newpage }, getTags )
            Just RouteArticles ->
                ( { model | loading = newpage }, getArticles )
            Just (RouteArticlePost n) ->
                ( { model | loading = newpage }, getArticlePost n )
            Just RouteTagsArticles ->
                ( { model | loading = newpage }, getTagsArticles )
            Just RouteMain ->
                ( {model | page=newpage}, Cmd.none)

    MsgNewTags (Ok newtags) ->
      ( { model | page=model.loading, tags=newtags, articles=[] }, Cmd.none)

    MsgNewTags (Err _) ->
      (model, Cmd.none)

    MsgNewArticles (Ok newarticles) ->
      ( { model | page=model.loading, tags=[], articles=newarticles } , Cmd.none)

    MsgNewArticles (Err _) ->
      (model, Cmd.none)

    MsgNewTagsArticles (Ok ( t, a ) ) ->
      ( { model | page=model.loading, tags=t, articles=a } , Cmd.none)

    MsgNewTagsArticles (Err _) ->
      (model, Cmd.none)

    MsgNewArticlePost (Ok newarticle) ->
      ( { model | page=model.loading, tags=[], articles=[newarticle] } , Cmd.none)

    MsgNewArticlePost (Err _) ->
      (model, Cmd.none)

 MsgNewUrlはリンクボタンが押されたときに発生するMsgです。

update(1)
  case msg of
    MsgNewUrl url ->
      ( model
       ,Navigation.newUrl url
      )

 MsgUrlChangeはブラウザのアドレスバーが変更されたときに発生するMsgです。aリンクやNavigation.newUrlをcallすることで発生します。ここで注意したいのはRoute情報によって行う処理が異なることです。

 まず先ほど定義したParserで現在のlocation(ブラウザのURL情報)をElm値(Route情報)に変換します。

newpage = Url.parsePath route location

 得られたRoute情報で場合分けし処理を行います。

 RouteHomeとRouteMainの場合は、直ちに画面を更新するために page = newpage とmodelを更新します。View関数はpageを見てどの画面を表示するかを決めているので、このタイミングで画面が遷移します。

 それ以外の場合は loading = newpage とmodelを更新します。View関数は呼ばれますが、loadingは見ていないので画面は更新されません。その代わり非同期通信のTaskをCmdでキックします。

update(2)
    MsgUrlChange location ->
      let
        _ = Debug.log "location=" location
        newpage = Url.parsePath route location
      in
        case newpage of
        case newpage of
            Nothing ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteHome ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteTags ->
                ( { model | loading = newpage }, getTags )
            Just RouteArticles ->
                ( { model | loading = newpage }, getArticles )
            Just (RouteArticlePost n) ->
                ( { model | loading = newpage }, getArticlePost n )
            Just RouteTagsArticles ->
                ( { model | loading = newpage }, getTagsArticles )
            Just RouteMain ->
                ( {model | page=newpage}, Cmd.none)

 上で発生した非同期Taskの終了時に別のMsgが発生します。以下に示したupdateのpage = loading としてView関数が呼ばれ画面の遷移が行われます。このようにサーバからのデータ取得が必要な場合は、わざと遅延させて画面遷移を起こします。エラー時にはmodelの更新が無いので画面はそのままです。

update(3)
    MsgNewTags (Ok newtags) ->
      ( { model | page=model.loading, tags=newtags, articles=[] }, Cmd.none)

    MsgNewTags (Err _) ->
      (model, Cmd.none)

    MsgNewArticles (Ok newarticles) ->
      ( { model | page=model.loading, tags=[], articles=newarticles } , Cmd.none)

    MsgNewArticles (Err _) ->
      (model, Cmd.none)

    MsgNewTagsArticles (Ok ( t, a ) ) ->
      ( { model | page=model.loading, tags=t, articles=a } , Cmd.none)

    MsgNewTagsArticles (Err _) ->
      (model, Cmd.none)

    MsgNewArticlePost (Ok newarticle) ->
      ( { model | page=model.loading, tags=[], articles=[newarticle] } , Cmd.none)

    MsgNewArticlePost (Err _) ->
      (model, Cmd.none)

5.Http非同期通信の処理

 上のupdate関数の中で getTags と getArticles、 getArticlePost、 getTagsArticlesの4つのCmd(Http非同期通信)を呼んでいます。これらはRest APIを叩いてサーバからデータを取得し、完了したらその旨をElmに知らせるために、適切なMsgを発生させます。ここで面倒なのが、サーバから取得したJson文字列を、Elm値に変換するDecodeの指定です。HaskellのAesonのように簡単にキレイに見やすい手段があればいいのに。Json.Decodeの説明は省きますが、必要に応じて以下のサイトも参照してください。
http://package.elm-lang.org/packages/elm-lang/core/5.1.1/Json-Decode
ElmのHttpとJson.Decode、Taskの実践的な使い方 - Qiita

url_tags =
    "http://www.mypress.jp:3090/tags"

url_articles =
    "http://www.mypress.jp:3090/articles"

requestTags : Http.Request (List Tag)
requestTags =
    Http.get url_tags ( Decode.field "animals" ( Decode.list ( Decode.map Tag Decode.string ) ) )


requestArticles : Http.Request (List Article)
requestArticles =
    Http.get url_articles ( Decode.list article )


article : Decode.Decoder Article
article =
    Decode.map2 toArticle (Decode.field "title" Decode.string) (Decode.field "story" Decode.string)

toArticle : String -> String -> Article
toArticle t s =
    { title=t, story=s }


getTags : Cmd Msg
getTags =
    Http.send MsgNewTags requestTags

getArticles : Cmd Msg
getArticles =
    Http.send MsgNewArticles requestArticles

getTagsArticles : Cmd Msg
getTagsArticles =
    Task.attempt MsgNewTagsArticles ( Task.map2 toPair ( Http.toTask (requestTags) )  ( Http.toTask (requestArticles) ) )

toPair : List Tag -> List Article -> (List Tag, List Article)
toPair t a =
    ( t, a )


getArticlePost : Int -> Cmd Msg
getArticlePost n =
    let
        url_post = url_articles ++ "/" ++ toString n
    in
    Http.send MsgNewArticlePost ( Http.get url_post article )

 まずtagsとarticlesを取得するためのRequestを書きます。

Request
requestTags : Http.Request (List Tag)
requestTags =
    Http.get url_tags ( Decode.field "animals" ( Decode.list ( Decode.map Tag Decode.string ) ) )


requestArticles : Http.Request (List Article)
requestArticles =
    Http.get url_articles ( Decode.list article )

 次に上のRequestに対してHttp.sendでコマンドを作ります。得られた結果はMsgNewTagsとMsgNewArticlesというMsgでElmの世界に還元されます。
http://package.elm-lang.org/packages/elm-lang/http/latest/Http

Cmd
getTags : Cmd Msg
getTags =
    Http.send MsgNewTags requestTags

getArticles : Cmd Msg
getArticles =
    Http.send MsgNewArticles requestArticles

 以下はtagsとarticlesを一回のCmdで取得する方法です。2つのRequestをTaskに変換し、2つのTaskをTask.map2で合成します。合成されたTaskは、まず最初のTaskを処理し、成功したら2番目のTaskを処理します。得られた結果はMsgNewTagsArticlesというMsgでElmの世界に還元されます。いずれかのTaskが失敗したら、合成されたTaskの失敗となります。
http://package.elm-lang.org/packages/elm-lang/core/latest/Task

Taskの合成
getTagsArticles : Cmd Msg
getTagsArticles =
    Task.attempt MsgNewTagsArticles ( Task.map2 toPair ( Http.toTask (requestTags) )  ( Http.toTask (requestArticles) ) )

toPair : List Tag -> List Article -> (List Tag, List Article)
toPair t a =
    ( t, a )

 最後にgetArticlePostですが、これは最もシンプルですね。Decoder のarticleをそのまま再利用します。成功するとMsgNewArticlePost というMsgが発生します。

getArticlePost : Int -> Cmd Msg
getArticlePost n =
    let
        url_post = url_articles ++ "/" ++ toString n
    in
    Http.send MsgNewArticlePost ( Http.get url_post article )

6.View関数

 view関数はmodelが更新されたときに、その更新を画面に反映させるために呼ばれます。今回は、リンクボタンがクリックされ、ページの切り替えが必要になったときに呼ばれます。model.pageに現在表示すべきページ(Route情報)が入っています。またmodel.tagsとmodel.articlesにサーバから取得したデータが入っています。これらの情報を反映させるべくview関数は描画を行います。

view関数
view : Model -> Html Msg
view model =
  div []
    [ h1 [] [ text "Links" ]
    , ul [] (List.map viewLink [ "/", "/tags/", "/articles/","/tags-articles/","/articles/1/", "/articles/2/", "/articles/3/" ])
    , h1 [] [ text "各ページの画面です" ]
    , div [] [ viewRoute model ]
    ]

viewLink : String -> Html Msg
viewLink url =
  li [] [ button [ onClick (MsgNewUrl url) ] [ text url ] ]


viewRoute : Model -> Html msg
viewRoute model =
  let
    _ = Debug.log "maybeRoute=" model.page
  in
  case model.page of
    Nothing ->
      h2 [] [ text "404 Page Not Found!"]

    Just route ->
      viewPage route model


viewPage : Route -> Model -> Html msg
viewPage route model =
  case route of
    RouteHome ->
      div []
        [ h2 [] [text "Welcomw to My Page!"]
        , p [] [ text "これはテストページのトップです" ]
        ]

    RouteTags ->
      div []
        [ h2 [] [text "タグ一覧"]
        , p [] [ text "これはタグの一覧ページです" ]
        , ul [] (List.map viewTags model.tags)
        ]

    RouteArticles ->
      div []
        [ h2 [] [text "ブログ一覧"]
        , p [] [ text "これはブログの一覧ページです" ]
        , ul [] (List.map viewArticles model.articles)
        ]

    RouteTagsArticles ->
      div []
        [ h2 [] [text "タグ&ブログ一覧"]
        , p [] [ text "これはタグ&ブログの一覧ページです" ]
        , ul [] (List.map viewTags model.tags)
        , ul [] (List.map viewArticles model.articles)
        ]


    RouteArticlePost id ->
      div []
        [ h2 [] [text "ブログ記事表示"]
        , p [] [ text ("これはブログの記事("++ toString id ++")を表示します") ]
        , ul [] (List.map viewArticles model.articles)
        ]

    RouteMain ->
      div []
        [ h2 [] [text "初期画面"]
         ,p [] [ text "これはプログラムがロードされた初期画面です。" ]
        ]


viewTags (Tag t) =
    li [] [ text t ]

viewArticles a =
    li []
      [ h3 [] [ text a.title]
      , p  [] [ text a.story]
      ]

7.Elmプログラム全体

以下にソースコードを示しますが、まだ説明していない部分を最後に付け加えます。

Main.elm
import Html exposing (..)
import Html.Attributes exposing (href)
import Html.Events exposing (onClick)
import Http
import Navigation
import UrlParser as Url exposing ((</>), (<?>), s, int, stringParam, top)
import Json.Decode as Decode
import Task exposing (Task)

main =
  Navigation.program MsgUrlChange
    { init = init
    , view = view
    , update = update
    , subscriptions = subscriptions
    }


init : Navigation.Location -> ( Model, Cmd Msg )
init location =
  ( Model Nothing (Url.parsePath route location) [] []
  , Cmd.none
  )


-- MODEL
type Tag
    = Tag String

type alias Article =
    { story : String
    , title : String
    }

type alias Model =
  { loading : Maybe Route
  , page : Maybe Route
  , tags : List Tag
  , articles : List Article
  }


-- URL PARSING
type Route
  = RouteHome
  | RouteTags
  | RouteArticles
  | RouteArticlePost Int
  | RouteTagsArticles
  | RouteMain


route : Url.Parser (Route -> a) a
route =
  Url.oneOf
    [ Url.map RouteHome top
    , Url.map RouteTags (Url.s "tags")
    , Url.map RouteArticles (Url.s "articles")
    , Url.map RouteArticlePost (Url.s "articles" </> int)
    , Url.map RouteTagsArticles (Url.s "tags-articles")
    , Url.map RouteMain (Url.s "Main.elm")
    ]


-- UPDATE
type Msg
  = MsgNewUrl String
  | MsgUrlChange Navigation.Location
  | MsgNewTags (Result Http.Error (List Tag))
  | MsgNewArticles (Result Http.Error (List Article))
  | MsgNewTagsArticles (Result Http.Error (List Tag, List Article) )
  | MsgNewArticlePost (Result Http.Error Article)


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
  case msg of
    MsgNewUrl url ->
      ( model
       ,Navigation.newUrl url
      )

    MsgUrlChange location ->
      let
        _ = Debug.log "location=" location
        newpage = Url.parsePath route location
      in
        case newpage of
            Nothing ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteHome ->
                ( {model | page=newpage}, Cmd.none)
            Just RouteTags ->
                ( { model | loading = newpage }, getTags )
            Just RouteArticles ->
                ( { model | loading = newpage }, getArticles )
            Just (RouteArticlePost n) ->
                ( { model | loading = newpage }, getArticlePost n )
            Just RouteTagsArticles ->
                ( { model | loading = newpage }, getTagsArticles )
            Just RouteMain ->
                ( {model | page=newpage}, Cmd.none)

    MsgNewTags (Ok newtags) ->
      ( { model | page=model.loading, tags=newtags, articles=[] }, Cmd.none)

    MsgNewTags (Err _) ->
      (model, Cmd.none)

    MsgNewArticles (Ok newarticles) ->
      ( { model | page=model.loading, tags=[], articles=newarticles } , Cmd.none)

    MsgNewArticles (Err _) ->
      (model, Cmd.none)

    MsgNewTagsArticles (Ok ( t, a ) ) ->
      ( { model | page=model.loading, tags=t, articles=a } , Cmd.none)

    MsgNewTagsArticles (Err _) ->
      (model, Cmd.none)

    MsgNewArticlePost (Ok newarticle) ->
      ( { model | page=model.loading, tags=[], articles=[newarticle] } , Cmd.none)

    MsgNewArticlePost (Err _) ->
      (model, Cmd.none)

-- HTTP
url_tags =
    "http://www.mypress.jp:3090/tags"

url_articles =
    "http://www.mypress.jp:3090/articles"

requestTags : Http.Request (List Tag)
requestTags =
    Http.get url_tags ( Decode.field "animals" ( Decode.list ( Decode.map Tag Decode.string ) ) )


requestArticles : Http.Request (List Article)
requestArticles =
    Http.get url_articles ( Decode.list article )


article : Decode.Decoder Article
article =
    Decode.map2 toArticle (Decode.field "title" Decode.string) (Decode.field "story" Decode.string)

toArticle : String -> String -> Article
toArticle t s =
    { title=t, story=s }


getTags : Cmd Msg
getTags =
    Http.send MsgNewTags requestTags

getArticles : Cmd Msg
getArticles =
    Http.send MsgNewArticles requestArticles

getTagsArticles : Cmd Msg
getTagsArticles =
    Task.attempt MsgNewTagsArticles ( Task.map2 toPair ( Http.toTask (requestTags) )  ( Http.toTask (requestArticles) ) )

toPair : List Tag -> List Article -> (List Tag, List Article)
toPair t a =
    ( t, a )


getArticlePost : Int -> Cmd Msg
getArticlePost n =
    let
        url_post = url_articles ++ "/" ++ toString n
    in
    Http.send MsgNewArticlePost ( Http.get url_post article )


-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
  Sub.none


-- VIEW
view : Model -> Html Msg
view model =
  div []
    [ h1 [] [ text "Links" ]
    , ul [] (List.map viewLink [ "/", "/tags/", "/articles/","/tags-articles/","/articles/1/", "/articles/2/", "/articles/3/" ])
    , h1 [] [ text "各ページの画面です" ]
    , div [] [ viewRoute model ]
    ]


viewLink : String -> Html Msg
viewLink url =
  li [] [ button [ onClick (MsgNewUrl url) ] [ text url ] ]



viewRoute : Model -> Html msg
viewRoute model =
  let
    _ = Debug.log "maybeRoute=" model.page
  in
  case model.page of
    Nothing ->
      h2 [] [ text "404 Page Not Found!"]

    Just route ->
      viewPage route model


viewPage : Route -> Model -> Html msg
viewPage route model =
  case route of
    RouteHome ->
      div []
        [ h2 [] [text "Welcomw to My Page!"]
        , p [] [ text "これはテストページのトップです" ]
        ]

    RouteTags ->
      div []
        [ h2 [] [text "タグ一覧"]
        , p [] [ text "これはタグの一覧ページです" ]
        , ul [] (List.map viewTags model.tags)
        ]

    RouteArticles ->
      div []
        [ h2 [] [text "ブログ一覧"]
        , p [] [ text "これはブログの一覧ページです" ]
        , ul [] (List.map viewArticles model.articles)
        ]

    RouteTagsArticles ->
      div []
        [ h2 [] [text "タグ&ブログ一覧"]
        , p [] [ text "これはタグ&ブログの一覧ページです" ]
        , ul [] (List.map viewTags model.tags)
        , ul [] (List.map viewArticles model.articles)
        ]


    RouteArticlePost id ->
      div []
        [ h2 [] [text "ブログ記事表示"]
        , p [] [ text ("これはブログの記事("++ toString id ++")を表示します") ]
        , ul [] (List.map viewArticles model.articles)
        ]

    RouteMain ->
      div []
        [ h2 [] [text "初期画面"]
         ,p [] [ text "これはプログラムがロードされた初期画面です。" ]
        ]


viewTags (Tag t) =
    li [] [ text t ]

viewArticles a =
    li []
      [ h3 [] [ text a.title]
      , p  [] [ text a.story]
      ]

 まだ説明していないのは以下のmain関数です。このように定義することで、ブラウザのアドレスバーが変更されたときに、MsgUrlChangeというMsgを発生するようになります。ハッシュ("#")付きのaリンクのクリックや、Navigation.newUrlでアドレスバーが変更されますので、MsgUrlChangeが発生することになります。

main関数
main =
  Navigation.program MsgUrlChange
    { init = init
    , view = view
    , update = update
    , subscriptions = subscriptions
    }

 elmの課題として残っているのは、auth関連とMaterial Design Lite関連かな~