読者です 読者をやめる 読者になる 読者になる

レガシーコード生産ガイド

私に教えられることなら

静的型付き関数型言語ElmでWebアプリ(SPA)を作ってみた

以下の記事を見てElmがかなり気になりました。

私は型推論ありの静的型付き関数型言語(と言えばいいんでしょうか)でプログラミングした経験が殆どありません。このブログに昔Haskellを触っていた記録がありますが、今読み返しても何書いてるかさっぱりわかりませんでした。

型推論での静的型付けの強力さについては最近よく目にします。動的型付き言語での開発時に起きるエラーがどのようなものか少し記録を取ってみたところ、確かにこれはコンパイル時に弾けるかもしれない、と思うものがある程度ありました。しかし、他の言語でも30分で書けるような簡単なサンプルか、難しすぎてまったくわからない記事しか探し出せず、本当に今使っている物と比べて楽になるのか疑わしく感じていました。

そこで、次の点を確かめるために、少し時間を書けてSPAを書いてみました。

  1. 本当に頻繁な仕様変更に強いのか
  2. 本当にコンパイルエラーが無ければ安心できるのか
  3. コンパイルエラーを解決するのは実行時エラーのデバッグより簡単なのか
  4. 開発時の他の不安についてはどうか

使用したElmのバージョンは0.17です。公式サイトのテキストフィールド値取得デモから出発して、まずTODOリストに書き換え、更にそのコードのまま簡単なブログシステムに変更しました。サーバー側はJavaScript(Node.jsとExpress)です。Elmの環境構築から始めて合計13時間かかりました。あくまでも試した感想なので、手順などは書きません。(ハマったところは多かったので、要望があれば書くかもしれません)

機能は

  • 記事一覧と記事内容をGETで取得、POSTで記事内容の更新(記事作成と削除は飽きたので無し)
  • Elm側で記事ID別のルーティング
  • ユーザーログイン
  • おまけで、リアルタイムMarkdownプレビュー

というものです。SPAで作るようなものでは無いと思いますが、そういったものも作りやすいか、の実験です。

後から参照した時にデモが見れないのは嫌なので動画にしました。

youtu.be

コードも消えると嫌なので、Elmのコードを最後にそのまま貼り付けています。このために1ファイルのみで書きました。500行程度ですが、exposingの衝突が多少面倒だったので、積極的にファイル分けた方が良さそうです。

気になってたところ

1. 本当に頻繁な仕様変更に強いのか

ポモドーロ計測つきのTODOリスト(JSONでサーバとやりとりして保存)から記事別URLを持つブログに変更し、またルーティング等を足していく際も全然先のことを考えずに場当たり的に設計してみました。確かに型とコンパイラが「次に何をするべきか」を教えてくれる、という感覚は掴めました。動いているところを一気に消して、変更のための型を書き、あとはコンパイルエラーを潰しながら実装するというやり方で楽に変更できました。仕様変更に関するストレスは今までの経験の中で一番少なく感じました。

2. 本当にコンパイルエラーが無ければ安心できるのか

実際にエラーがあるかどうかの話ではなく、安心感の話です。モチベーションを左右するので何よりも大事だと思います。少し慣れてきた段階で、コンパイルが通るだけでテストをしっかり書いているときのような安心感がありました。実行時に出たエラーも、Route記述の順番によるミス程度で、殆どありませんでした。

3. コンパイルエラーを解決するのは実行時エラーのデバッグより簡単なのか

難しいです。Elmのエラーはかなり親切らしく、確かに気合を入れて読めば糸口は掴めますが、それでも「解決できないのでは」と3回ほど挫折しかけました。Elmのパッケージサイトにはサンプルや解説がかなり豊富に乗っているので、それにも助けられましたが、それらが不親切なモジュールを使ってしまったらお手上げだったと思います。

型エラーはコンパイル時に判明し、Elmには(多分)コンパイル時にコードを動かして実験する方法がありません。よってエラーが意味不明な場合、睨むしかないです。推論時にprintfか何かさせて欲しいと思いました(しても意味わからないと思いますが)。

4. 開発時の他の不安についてはどうか

Reduxに真似されたらしい(?)Elmのアーキテクチャですが、確かに単純なうちはどこを修正すればいいのかわかりやすくて楽です。0.17からのSubscriptionやCmdも単純ならかなりわかりやすい。

しかし、イベントの起点が一箇所ということは、その起点を把握できないと何もイベントを起こせないということです。アプリケーションを開いた時に一度ユーザを取得し、それ以降のSPA内遷移では自動で取得はしない、という単純なイベントを起こすのにかなり苦労しました。

なんとか起点を見つけて入れる事ができましたが、これより複雑なイベントの起こし方は正直実装できる自信がありません。Cmdを深く理解すればいいのかもしれませんが、理解できるかどうか読めなくて不安です。

イミュータブルな状態を1つ持つタイプの設計には同じような不安が付きまといそうです。参照型にしてストリームでいろいろするタイプの設計ではどうなんでしょうか。気になります。

Elmのいいところ

簡単さ・便利さを優先している設計がとても気に入りました。toStringやDebug.logをスルッと使えるのはとても楽です。

StandardMLにもあるのかもしれませんが、レコードが扱いやすくて気に入りました。

パッケージサイトのドキュメントの豊富さと、セマンティクスバージョニングもかなり気に入りました。

とにかくメイン開発者のEvan Czaplicki氏のバランス感覚が良さそうなので、これからに期待大です。

Elmのよくないところ

オフサイドルール。インデントで構造指定するやつです。利点無いです。インデント含めて整形は機械がやってほしい。にんげんがさき、インデントはあと。これ修正されない限り普段使う気にはなれません。

Elmに期待すること

まずはオフサイドルールの撤廃です。S式で書けたら最高なんですが。(またトランスレータ作るか……?)

それからサーバーサイドレンダリングです。今後の予定に入っているみたいなので期待大です。

サーバー側も全部Elmで書きたいと思いました。JSONに一度変換することなく、型安全性を保ったままダイレクトにElmレコードでやりとりしたいです。

他の言語での開発と比べて

今使っているいくつかの言語よりは明らかに楽です。特にWeb関係を完全に置き換えられるまで早く成長して欲しい。

ボイラープレートvsマジックではややボイラープレート側に心が傾きつつありますが、面倒なものは面倒なので、動的に強力なメタプログラミングが可能なものとは半々です。

今のところSmalltalkでの「どこまでもライブラリのソースを覗きこめて、必要があれば変更できる」「デバッガで楽に原因を特定でき、そのまま中で開発できる」という安心感が一番強かったので、そういう方向性の環境が出てきて欲しいと思います。

コード

module ElmBlog exposing (main)

import Html exposing (..)
import Html.Attributes as Attr exposing (attribute, placeholder, value)
import Html.App as App
import Html.Events exposing (..)
import Date exposing (Date, year, month, day, hour, minute, second)
import Task exposing (Task)
import Http
import Json.Decode as JD exposing ((:=))
import Json.Encode as JE
import Task as Task
import Debug as Debug
import Navigation
import UrlParser exposing (..)
import String
import Hop
import Hop.Types exposing (Config, Address, Query)
import Markdown

{- elm-mdl -}
import Material
import Material.Scheme
import Material.Button as Button
import Material.Options as Options exposing (css)
import Material.Grid exposing (..)
import Material.Textfield as Textfield
import Material.Color as Color
import Material.Layout as Layout



type Route
  = RtLogin
  | RtIndex
  | RtArticle Int
  | RtEditArticle Int
  | RtNotFound

hopConfig = { hash = False, basePath = ""}


type alias Article =
  { id : Int
  , title : String
  , content: String
  }

articleToJson : Article -> String
articleToJson article =
  JE.object
    [ ("id", JE.int article.id)
    , ("title", JE.string article.title)
    , ("content", JE.string article.content)
    ]
    |> JE.encode 0


type alias User = { name : String, password: String }

testuser = { name = "elmer", password = "elmer"}

userToJson : User -> String
userToJson user =
  JE.object [ ("name", JE.string user.name)
            , ("password", JE.string user.password)
            ]
            |> JE.encode 0

-- MODEL

type ModelContent
  = Blog Article
  | BlogList (List Article)
  | NoContent


type ModelUser
  = LoggedIn User
  | LoginFailed
  | NotLoggedIn

type alias Model =
    { content : ModelContent
    , user : ModelUser
    , address : Address
    , route : Route
    , mdl : Material.Model {- boilerplate: elm-mdl -}
    }



-- ROUTING, INIT, MAIN

main =
  Navigation.program urlParser
    { init = init
    , view = view
    , update = update
    , urlUpdate = urlUpdate
    , subscriptions = (\_ -> Sub.none)
    }

init : (Route, Address) -> (Model, Cmd Msg)
init (route, address) =
  let model = { user = NotLoggedIn
              , content = NoContent
              , route = route
              , address = address
              , mdl = Material.model {- boilerplate: elm-mdl -}
            }
  in
    urlUpdate (route, address) model


routes : UrlParser.Parser (Route -> a) a
routes =
  oneOf
    [ format RtIndex (UrlParser.s "")
    , format RtLogin (UrlParser.s "login")
    , format RtEditArticle (UrlParser.s "article" </> UrlParser.int </> UrlParser.s "edit")
    , format RtArticle (UrlParser.s "article" </> UrlParser.int)
    ]

urlParser : Navigation.Parser ( Route, Address )
urlParser =
  let
    parser path =
      path
        |> UrlParser.parse identity routes
        |> Result.withDefault RtNotFound
    resolver =
      Hop.makeResolver hopConfig parser
  in
    Navigation.makeParser (.href >> resolver)


urlUpdate : ( Route, Address ) -> Model -> ( Model, Cmd Msg )
urlUpdate ( route, address ) model =
    let model = { model | route = route, address = address } in
    model ! [prepareRoute model route]


prepareRoute : Model -> Route -> Cmd Msg
prepareRoute model route =
  let
    pageCmd = case route of
      RtIndex -> fetchArticleList
      RtLogin -> Cmd.none
      RtArticle id -> fetchArticle id
      RtEditArticle id -> fetchArticle id
      RtNotFound -> Cmd.none
    command = Cmd.batch [assureUser model, pageCmd]
  in
    command



-- VIEW

view : Model -> Html Msg
view model =
  rootView
    model
    (case model.route of
      RtIndex -> indexView model
      RtLogin -> loginView model
      RtArticle id -> articleView model id
      RtEditArticle id -> editArticleView model id
      RtNotFound -> notfoundView model)
    |> Material.Scheme.top

rootView model content =
  Options.div
    [ css "max-width" "800px"
    , css "margin" "auto"
    ]
    [ headerView model
    , content ]

headerView model =
  let
    userView =
      case model.user of
        LoggedIn user ->
          span [] [ text ("hello," ++ user.name ++ "!")]
        _ ->
          span [] [ loginLink ]
  in
    grid []
      [ cell [size All 12 ]
        [ Options.span [css "margin-right" "10px"] [ homeLink ]
        , userView
        ]
      ]

loginLink =
  anchor "/login" [] [text "Login"]

homeLink =
  anchor "/" [] [ text "Home"]

indexView model =
    div []
      [ grid []
        [ cell [size All 12] [ h2 [] [text "Articles"] ] ]
      , grid []
        [ cell [size All 12] [ articleListView model ] ]
      ]

articleListView model =
  case model.content of
    BlogList articles ->
      div [] (List.map articleItemView articles)
    _ ->
      div [] [text "no articles..."]

articleItemView article =
  let
    url = "/article/" ++ toString article.id
    title = article.title
  in
  div []
    [ anchor url [] [text title] ]

loginView model =
  div []
    [ grid []
      [ cell [size All 12] [ h1 []  [text "login?"] ] ]
    , grid []
      [ cell [size All 12]
          [ button [ onClick (Login testuser) ] [ text "Login" ] ] ]
    ]

articleView : Model -> Int -> Html Msg
articleView model id =
  let content = model.content in
  let
    toolView article =
      case model.user of
        LoggedIn _ ->
          grid [] [ cell [size All 12] [ articleToolView model article ]]
        _ ->
          span [] []
  in
  case content of
    Blog article ->
      div []
        [ toolView article
        , grid []
          [ cell [size All 12] [articleContentView article] ]
        ]
    _ ->
      div [] [text "loading..."]

articleToolView model article =
  let
    editButton =
      case model.user of
        LoggedIn _ ->
          Button.render Mdl [0] model.mdl
            [ Button.raised
            , Button.ripple
            , Button.colored
            , Button.onClick (NavigateTo ("/article/" ++ toString article.id ++ "/edit"))
            ]
            [ text "Edit"]
        _ ->
          span [] []
  in
    grid []
      [ cell [size All 12] [ editButton ] ]

articleContentView article =
    let title = "# " ++ article.title in
    let content = title ++ "\n" ++ article.content in
    Options.div
      [ css "border-left" "2px solid #CCCCCC"
      , css "padding" "5px 15px"]
      [ Markdown.toHtml [] content ]

editArticleView : Model -> Int -> Html Msg
editArticleView model id =
  let content = model.content in
  case content of
    Blog article ->
      div []
        [ grid []
            [ cell [ size All 12 ] [ articleEditorToolView model article ] ]
        , grid []
          [ cell [ size Tablet 12, size Desktop 6 ]
              [ articleEditorView model article ]
          , cell [ size Tablet 12, size Desktop 6 ]
              [ articleContentView article ]
          ]
        ]
    _ ->
      div [] [text "loading..."]

articleEditorView : Model -> Article -> Html Msg
articleEditorView model article =
  grid []
    [ cell [ size All 12 ]
      [ Textfield.render Mdl [0] model.mdl
          [ Textfield.label "記事タイトル"
          , Textfield.onInput (EditArticleTitle article)
          , Textfield.floatingLabel
          , Textfield.text'
          , Textfield.value article.title
          , css "width" "100%"
          ]
      ]
    , cell [ size All 12 ]
      [ Textfield.render Mdl [1] model.mdl
          [ Textfield.label "記事内容"
          , Textfield.onInput (EditArticleContent article)
          , Textfield.floatingLabel
          , Textfield.textarea
          , Textfield.rows 20
          , Textfield.value article.content
          , css "width" "100%"
          ]
      ]
    ]

articleEditorToolView model article =
  grid []
    [ cell [size All 4]
      [ Button.render Mdl [0] model.mdl
        [ Button.raised
        , Button.ripple
        , Button.colored
        , Button.onClick (NavigateTo ("/article/" ++ toString article.id))
        , css "margin-right" "15px"
        ]
        [ text "View"]
      , Button.render Mdl [0] model.mdl
        [ Button.raised
        , Button.ripple
        , Button.colored
        , Button.onClick (UpdateArticle article)
        ]
        [ text "Update"]
      ]
    ]

notfoundView model =
  div [] [ text ("NotFound" ++ toString model.address)
         , homeLink
         ]

{- Routing優先リンク -}
anchor url attrs =
  a ([ Attr.href url, onClick' (NavigateTo url) ] ++ attrs)

onClick' : msg -> Attribute msg
onClick' msg =
  onWithOptions
    "click"
    { defaultOptions | preventDefault = True }
    (JD.succeed msg)



-- UPDATE

type Msg
         = NavigateTo String
         | SetQuery Query
         | Mdl (Material.Msg Msg) {- boilerplate: elm-mdl -}
         | ShowArticle Int
         | ArticleFetched Article
         | ArticleListFetched (List Article)
         | Noop
         | ErrorOccured String
         | Login User
         | LoginSuccess Http.Response
         | UserFetched ModelUser
         | EditArticleTitle Article String
         | EditArticleContent Article String
         | UpdateArticle Article
         | UpdateArticleSuccess Http.Response


update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (Debug.log "[MSG] " msg) of
      Noop ->
          (model, Cmd.none)

      NavigateTo path ->
        let command =
          Hop.outputFromPath hopConfig path
            |> Navigation.newUrl
        in
          (model, command)

      ShowArticle id ->
        let path = "/article/" ++ (toString id) in
        model ! [navigate path]

      -- Boilerplate: Mdl action handler.
      Mdl msg' ->
        Material.update msg' model

      ArticleFetched article ->
        { model | content = Blog article } ! []

      ArticleListFetched articles ->
        { model | content = BlogList articles } ! []

      SetQuery query ->
        let command =
          model.address
            |> Hop.setQuery query
            |> Hop.output hopConfig
            |> Navigation.newUrl
        in
          (model, command)

      ErrorOccured err ->
        model ! []

      Login user ->
          model ! [ login user ]

      LoginSuccess res ->
          {model| user = LoggedIn testuser} ! []

      UserFetched modelUser ->
        { model | user = modelUser } ! []

      EditArticleTitle article title ->
        let
          newArticle = { article | title = title }
        in
          { model | content = Blog newArticle } ! []

      EditArticleContent article content ->
        let
          newArticle = { article | content = content }
        in
          { model | content = Blog newArticle } ! []

      UpdateArticle article ->
        model ! [updateArticle article]
      UpdateArticleSuccess res ->
        model ! []

navigate : String -> Cmd a
navigate path =
  Hop.outputFromPath hopConfig path
    |> Navigation.newUrl



-- http

articleDecoder : JD.Decoder Article
articleDecoder =
  JD.object3
    Article
    ("id" := JD.int)
    ("title" := JD.string)
    ("content" := JD.string)

articleListDecoder : JD.Decoder (List Article)
articleListDecoder =
  JD.list articleDecoder

fetchJson : JD.Decoder a -> String -> (a -> Msg) -> Cmd Msg
fetchJson decoder url msg =
  Http.get decoder url
    |> Task.mapError toString
    |> Task.perform ErrorOccured msg

fetchArticle : Int -> Cmd Msg
fetchArticle id =
  fetchJson
    articleDecoder
    ("/article/" ++ toString id ++ "/json")
    ArticleFetched

fetchArticleList : Cmd Msg
fetchArticleList =
  fetchJson
    articleListDecoder
    "/articles/json"
    ArticleListFetched

userDecoder : JD.Decoder ModelUser
userDecoder =
  JD.oneOf
    [ JD.map LoggedIn
        (JD.object2
          User
          ("name" := JD.string)
          ("password" := JD.string))
    , JD.null LoginFailed
    ]

fetchUser : Cmd Msg
fetchUser =
  fetchJson
    userDecoder
    "/api/whoami"
    UserFetched

postIt : String -> Http.Body -> Task Http.RawError Http.Response
postIt url body =
  Http.send Http.defaultSettings
    { verb = "POST"
    , headers = [("Content-type", "application/json")]
    , url = url
    , body = body
    }

assureUser : Model -> Cmd Msg
assureUser model =
  case model.user of
    NotLoggedIn ->
      fetchUser
    _ ->
      Cmd.none

login : User -> Cmd Msg
login user =
  postIt "/login" (userToJson user |> Http.string)
  |> Task.mapError toString
  |> Task.perform ErrorOccured LoginSuccess

updateArticle : Article -> Cmd Msg
updateArticle article =
  postIt "/api/article/update" (articleToJson article |> Http.string)
  |> Task.mapError toString
  |> Task.perform ErrorOccured UpdateArticleSuccess
広告を非表示にする