Elmでマテリアルデザインをためしてみた！

　Elmでマテリアルデザインをためしてみたら意外と簡単にできた！、という記事です。Elmは純粋関数型言語で、ロジックをそれなりにキチンとかけるのがウリです。しかしまず第一義的にはフロントエンドのUIを記述するための言語です。それなりにキレイな画面を作れなくては話になりません。開発効率がウリのElmですから、UIの開発も効率よく行えなければ意味がないのです。

　そこでelm-mdlの登場です。これはElmで簡単にMaterial Design Lite (MDL)を使えるようにしてくれるライブラリです。ReactにおけるMaterial-UI的な位置づけです。今回は前回の記事で取り上げたプログラムをマテリアルデザイン化してみます。プログラムの機能は同じですが、見た目だけを変えました。
Elmで非同期Http通信を含んだSPAを試してみる - Qiita

　まずは画像を紹介します。

１．プログラムの画面キャプチャー

　あまりセンスの良い画面ではないですが、基本的に前のプログラムを、そのままマテリアル化したものです。変更点が少なく、変更点に番号付きのコメントを入れているので、プログラムの比較はたやすいと思います。以下3枚の画像を示しますが、共通点はリンクボタンがマテリアルのボタンになっている点です。

１－１．タグ一覧の画面

マテリアルのListを使っています。

１－２．ブログ記事一覧の画面

マテリアルのElevationとCardを使っています。

１－３．タグ一覧とブログ記事一覧の画面

上の２つを組み合わせています。

２．準備

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

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

　次に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 

３．プログラムの全ソース

前述したように今回のプログラムは以下の記事のものを微修正したものです。
Elmで非同期Http通信を含んだSPAを試してみる - Qiita

　修正した個所は以下のような番号付きのコメントを付けておきました。これでマテリアル化の前後の差分が簡単に目視確認できます。

-- ***MDL-1

　変更箇所はMDL-1からMDL-8までの8か所です。以下に説明していきます。

Main.elm

import Html exposing (..)
import Html.Attributes exposing (href,style)
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)

-- ***MDL-1
import Material
import Material.Scheme
import Material.Button as Button
import Material.Options as Options exposing (css)
import Material.Card as Card 
import Material.Color as Color
import Material.Elevation as Elevation
import Material.List as Lists

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


init : Navigation.Location -> ( Model, Cmd Msg )
init location =  -- ***MDL-2: Boilerplate: Always use this initial Mdl model store.
  ( Model Nothing (Url.parsePath route location) [] [] Material.model
  , 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
  , mdl : Material.Model -- ***MDL-3 : Boilerplate: model store for any and all Mdl components you use.
  }



-- 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)
  | Mdl (Material.Msg Msg) -- ***MDL-4 : Boilerplate: Msg clause for internal Mdl messages.

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)

    -- ***MDL-5 : Boilerplate: Mdl action handler.
    Mdl msg_ ->
        Material.update Mdl msg_ model


-- 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 =
    { story=s, title=t }


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


type alias Mdl = -- ***MDL-6
    Material.Model


-- VIEW
view : Model -> Html Msg
view model =
  div []
    [ h1 [] [ text "Links" ]
    , ul [] (List.map (viewLink model) [ "/", "/tags/", "/articles/","/tags-articles/","/articles/1/", "/articles/2/", "/articles/3/" ])
    , div [] [ viewRoute model ]
    ]
    |> Material.Scheme.top -- ***MDL-7

viewLink : Model -> String -> Html Msg   -- ***MDL-8
viewLink model url =
  -- li [] [ button [ onClick (MsgNewUrl url) ] [ text url ] ]
  li [ style [ ("display", "inline-block") ] ] [ 
          Button.render Mdl
            [ 0 ]
            model.mdl
            [ Button.raised
            , Options.onClick  (MsgNewUrl url)
            , css "margin" "0 6px"
            ]
            [ 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 "これはタグの一覧ページです" ]
        , Lists.ul [] (List.map viewTags model.tags)
        ]

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

    RouteTagsArticles ->
      div []
        [ h2 [] [text "タグ＆ブログ一覧"]
        , p [] [ text "これはタグ＆ブログの一覧ページです" ]
        , Lists.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) =
    Lists.li []
      [ Lists.content []
          [ Lists.icon "inbox" []
          , text t
          ]
      ]


white : Options.Property c m 
white = 
  Color.text Color.white 

viewArticles a =
  div [ style [("padding","10px"), ("margin","10px")] ]
    [
      Options.div
        [ Elevation.e6
        , css "width"  "800px" 
        , Options.center
        ]
        [
          Card.view
            [ css "width" "800px"
            , Color.background (Color.color Color.Pink Color.S500)
            ]
            [ Card.title [] [ Card.head [ white ] [ text a.title ] ]
            , Card.text [ white ] [ text <| a.story ]
            ]
        ]
    ] 

　最初にelm-mdlのドキュメントサイトです。必要に応じて参照してください。
http://package.elm-lang.org/packages/debois/elm-mdl/8.1.0

　まずは必要なMaterialのimportします。Material-UIの場合もそうだったんですが、ブラウザ（特にモバイルの）に負荷を加えないように、必要なものだけ個別にimportするのが良いようです。

-- ***MDL-1
import Material
import Material.Scheme
import Material.Button as Button
import Material.Options as Options exposing (css)
import Material.Card as Card 
import Material.Color as Color
import Material.Elevation as Elevation
import Material.List as Lists

　次にModelの初期値ですが、Modelの定義変更に沿って、Material.modelを指定します。Material.modelは初期値として常に使われるみたいです。

init : Navigation.Location -> ( Model, Cmd Msg )
init location =  -- ***MDL-2: Boilerplate: Always use this initial Mdl model store.
  ( Model Nothing (Url.parsePath route location) [] [] Material.model
  , Cmd.none
  )

　前述したようにModelの定義にfieldのmdlを追加します。これは決めごとです。

type alias Model =
  { loading : Maybe Route
  , page : Maybe Route
  , tags : List Tag
  , articles : List Article
  , mdl : Material.Model -- ***MDL-3 : Boilerplate: model store for any and all Mdl components you use.
  }

　Msgの定義にもMdl (Material.Msg Msg) を追加します。これは決めごとです。

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)
  | Mdl (Material.Msg Msg) -- ***MDL-4 : Boilerplate: Msg clause for internal Mdl messages.

　updateの定義にもMdl msg_を追加します。これも決めごとです。

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

    --

    -- ***MDL-5 : Boilerplate: Mdl action handler.
    Mdl msg_ ->
        Material.update Mdl msg_ model

　Msg コンストラクタ (Mdl)を定義します。これは MdlのmessagesをこのメインmoduleのMsgへと持ち上げる（リフトする）ものです。

type alias Mdl = -- ***MDL-6
    Material.Model

　Material.Scheme.topでデフォルトのcolor schemeを使うようになります。

view : Model -> Html Msg
view model =
  div []
    [ h1 [] [ text "Links" ]
    , ul [] (List.map (viewLink model) [ "/", "/tags/", "/articles/","/tags-articles/","/articles/1/", "/articles/2/", "/articles/3/" ])
    , div [] [ viewRoute model ]
    ]
    |> Material.Scheme.top -- ***MDL-7

以下はMDL-8の説明ですが、多少長いので小分けにして説明していきます。

viewLink : Model -> String -> Html Msg   -- ***MDL-8
viewLink model url =
  -- li [] [ button [ onClick (MsgNewUrl url) ] [ text url ] ]
  li [ style [ ("display", "inline-block") ] ] [ 
          Button.render Mdl
            [ 0 ]
            model.mdl
            [ Button.raised
            , Options.onClick  (MsgNewUrl url)
            , css "margin" "0 6px"
            ]
            [ text  url ]
        ]

　Button.renderでボタンを描いています。
　第１引数はMsgコンストラクタのMdlです。
　第２引数はindex [0]です。同じmodelコレクション(model.mdl)を使うcomponentはユニークなindexを持ちます。
　第３引数はelm-mdl model collection へのリファレンス(model.mdl)です。
　第４引数はMdl componentsの設定です。Html.Attributesのようなものです。
　第５引数は子要素ですね。

viewTags (Tag t) =
    Lists.li []
      [ Lists.content []
          [ Lists.icon "inbox" []
          , text t
          ]
      ]

　タグ一覧をList Componentで表しています。icon付きです。

viewArticles a =
  div [ style [("padding","10px"), ("margin","10px")] ]
    [
      Options.div
        [ Elevation.e6
        , css "width"  "800px" 
        , Options.center
        ]
        [
          Card.view
            [ css "width" "800px"
            , Color.background (Color.color Color.Pink Color.S500)
            ]
            [ Card.title [] [ Card.head [ white ] [ text a.title ] ]
            , Card.text [ white ] [ text <| a.story ]
            ]
        ]
    ]

　記事欄の枠をElevationで立体的に描きます。枠の中身はCardでまとめています。

　まだ少ししか試していませんが、Elmでもいい感じにMaterial Designが使えるのは嬉しいことです。ガゼンElmへのモティベーションが上がりますね。

読んで面白かったブログ
http://jinjor-labo.hatenablog.com/entry/2017/05/12/183154