せっかくアドベントカレンダーに参加すると言うことで頑張ってみました。なお完成までに2週間かかってます・・・orz

PureScript って何？

JavaScript は関数型言語であると言う人がいます。確かに関数型プログラミングはできますが、それはレガシーでない現在の言語のほとんどにおいて言うことができます。それら多くの言語の中で JavaScript は関数型プログラミングがやりにくい方だと私は思っています。

JavaScript で関数型プログラミングをもっとしやすくするにはどうしたらいいのかと考えた人たちは、3つの方向に持って行きました。

関数型プログラミングを補助するライブラリを作る。例: Ramdajs
関数型プログラミングしやすくするように言語機能を拡張する。例: LiveScript
純粋関数型言語として作り直す。例: PureScript

PureScript は3番目になります。Haskell を参考につくられた純粋関数型 altJS、それが PureScriptなのです。

チュートリアルの作成

準備する

さっそくチュートリアルを書き換えていきましょう。React Tutorial はあらかじめクローンしておいてください。当たり前ですが、node.js も入れておいてください。

npm で PureScriptを入れます。

$ npm install -g purescript
$ npm install -g pulp

チュートリアルを展開している場所で pulp を用いて PureScript の準備をします。

$ pulp init
$ pulp dep install purescript-react --save
$ pulp dep install purescript-datetime --save
$ pulp dep install purescript-timers --save
$ pulp dep install purescript-affjax --save
$ pulp dep install purescript-argonaut --save

PureScript をコンパイルするときは下記コマンドで行います。package.json の scripts に入れとくと便利かも知れません。

$ pulp build -O -t public/scripts/example.js

index.htmlを書き換える

purescript-reactは執筆時点でReact.js 0.13.3までにしか対応していません。0.14.0以降の対応については既にPRがありますので、そのうちマージされると思います。jQuery とかは使わなくなるので除いておきます。

public/scripts/index.html

<!DOCTYPE html>
<html>
  <head>
    <meta charset="utf-8">
    <title>React Tutorial</title>
    <!-- Not present in the tutorial. Just for basic styling. -->
    <link rel="stylesheet" href="css/base.css" />
    <script src="https://cdnjs.cloudflare.com/ajax/libs/react/0.13.3/react.js"></script>
    <script src="https://cdnjs.cloudflare.com/ajax/libs/marked/0.3.2/marked.min.js"></script>
  </head>
  <body>
    <div id="content"></div>
    <script src="scripts/example.js"></script>
  </body>
</html>

ソースを書く

PureScript のソースは src 配下に置いていきます。PureScript 自体は *.purs、外部の JavaScript を書く場合は *.js になります。

src/Main.purs

-- |This file provided by Facebook is for non-commercial testing and evaluation
-- purposes only. Facebook reserves all rights not expressly granted.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
-- FACEBOOK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-- WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
module Main where

import Prelude

import Control.Monad.Eff
import Control.Monad.Eff.Console (error)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Aff (launchAff)

import Data.Maybe
import Data.Maybe.Unsafe (fromJust)
import Data.Either
import Data.Either.Unsafe (fromRight)
import Data.Nullable (toMaybe)

import Data.Array (filter)
import Data.String (null)
import Data.Tuple (Tuple(..))

import Data.Date (nowEpochMilliseconds)
import Data.Time (Milliseconds(..))

import Data.Argonaut ((.?), toArray, jsonParser)
import Data.Argonaut.Decode (DecodeJson, decodeJson)

import Unsafe.Coerce (unsafeCoerce)

import Network.HTTP.Affjax (get, post)
import Network.HTTP.StatusCode (StatusCode(..))
import Network.HTTP.MimeType.Common (applicationFormURLEncoded)
import Network.HTTP.Affjax.Request (Requestable)

import DOM (DOM())
import DOM.HTML (window)
import DOM.HTML.Types (htmlDocumentToNonElementParentNode)
import DOM.HTML.Window (document)
import DOM.Node.NonElementParentNode (getElementById)
import DOM.Node.Types (ElementId(..))
import DOM.Timer (interval)

import React
import qualified React.DOM as D
import qualified React.DOM.Props as P

foreign import marked :: forall r. String -> { sanitize :: Boolean | r } -> String
foreign import _span :: Array P.Props -> ReactElement
foreign import getTargetValueFromEvent :: Event -> String
foreign import preventDefault :: forall eff. Event -> Eff (eff) Unit

newtype Comment = Comment { id :: Number, author :: String, text :: String }

toObject :: Comment -> { id :: Number, author :: String, text :: String }
toObject (Comment obj) = obj

foreign import toFormURLEncoded :: Comment -> String

instance decodeJsonComment :: DecodeJson Comment where
  decodeJson json = do
    obj <- decodeJson json
    id <- obj .? "id"
    author <- obj .? "author"
    text <- obj .? "text"
    pure $ Comment { id: id, author: author, text: text }

instance requestableComment :: Requestable Comment where
  toRequest cmt = Tuple (Just applicationFormURLEncoded) (unsafeCoerce (toFormURLEncoded cmt))

comment :: forall props. ReactClass { author :: String, text :: String | props }
comment = createClass $ spec unit \ctx -> do
  props <- getProps ctx
  return $ D.div [ P.className "comment" ]
                 [ D.h2 [ P.className "commentAuthor" ]
                        [ D.text props.author ]
                 , _span [ P.dangerouslySetInnerHTML $ rawMarkup props.text ]
                 ]
  where
    rawMarkup str = { __html: rawMarkup' str }
    rawMarkup' str = marked str { sanitize: true }

commentBox :: forall props. ReactClass { url :: String, pollInterval :: Int | props }
commentBox = createClass commentBoxSpec
  where
  commentBoxSpec = (spec {data: []} render)
    { componentDidMount = \ctx -> do
      props <- getProps ctx
      loadCommentsFromServer ctx
      interval props.pollInterval $ loadCommentsFromServer ctx
      return unit
    }
  render ctx = do
    state <- readState ctx
    return $ D.div [ P.className "commentBox" ]
                   [ D.h1' [ D.text "Comments" ]
                   , createFactory commentList { data: state.data }
                   , createFactory commentForm { onCommentSubmit: handleCommentSubmit ctx }
                   ]
  loadCommentsFromServer ctx = do
    props <- getProps ctx
    launchAff $ do
      res <- get props.url
      let errorMsg = affErrorMsg "GET" props.url res.status
      case res.status of
        StatusCode 200 -> either (\msg -> errorMsg msg) (liftEff <<< writeStateJson ctx) (jsonParser res.response)
        _ -> errorMsg res.response
  handleCommentSubmit ctx cmt = do
    state <- readState ctx
    props <- getProps ctx
    nowId <- millisecondsToNumber <$> nowEpochMilliseconds
    let cmt' = { id: nowId, author: cmt.author, text: cmt.text }
    launchAff $ do
      res <- post props.url (Comment cmt')
      let errorMsg = affErrorMsg "POST" props.url res.status
      case res.status of
        StatusCode 200 -> do
          liftEff $ writeState ctx { data: (state.data ++ [cmt']) }
          return unit
        _ -> do
          liftEff $ writeState ctx { data: (state.data) }
          errorMsg res.response
  millisecondsToNumber (Milliseconds n) = n
  affErrorMsg method url status msg = liftEff $ error $ method ++ " " ++ url ++ " " ++ show status ++ ": " ++ msg
  toComment json = do
    cmt <- decodeJson json :: Either String Comment
    pure $ toObject cmt
  writeStateJson ctx json = do
    let list = fromJust $ toArray json
    writeState ctx { data : fromRight <$> filter isRight (toComment <$> list) }
    return unit

commentList :: forall props cmt.
  ReactClass { data :: Array { id :: Number, author :: String, text :: String | cmt } | props }
commentList = createClass $ spec unit \ctx -> do
  props <- getProps ctx
  return $ D.div [ P.className "commentList"] $ commentNodes props.data
  where
  commentNodes = map \cmt -> createElement comment { key: cmt.id, author: cmt.author, text: cmt.text }
                                                   [ D.text cmt.text ]

commentForm :: forall props state eff.
  ReactClass { onCommentSubmit :: { text :: String , author :: String }
                                  -> Eff ( refs :: ReactRefs ( read :: Read )
                                         , props :: ReactProps
                                         , state :: ReactState ( read :: Read, write :: Write )
                                         | eff ) state
  | props }
commentForm = createClass $ spec {author: "", text: ""} \ctx -> do
  state <- readState ctx
  return $ D.form [ P.className "commentForm"
                  , P.onSubmit (handleSubmit ctx)
                  ]
                  [ D.input [ P._type "text"
                            , P.placeholder "Your name"
                            , P.value state.author
                            , P.onChange (handleAuthorChange ctx)
                            ] []
                  , D.input [ P._type "text"
                            , P.placeholder "Say something..."
                            , P.value state.text
                            , P.onChange (handleTextChange ctx)
                            ] []
                  , D.input [ P._type "submit"
                            , P.value "Post"
                            ] []
                  ]
  where
  handleSubmit ctx e = do
    preventDefault e
    state <- readState ctx
    props <- getProps ctx
    case null state.author || null state.text of
      true  -> return state
      false -> do
        props.onCommentSubmit { author: state.author, text: state.text }
        writeState ctx { author: "", text: "" }
  handleAuthorChange ctx e = do
    state <- readState ctx
    writeState ctx { author: getTargetValueFromEvent e, text: state.text }
  handleTextChange ctx e = do
    state <- readState ctx
    writeState ctx { author: state.author, text: getTargetValueFromEvent e }

main :: forall eff. Eff (dom :: DOM | eff) ReactElement
main = container >>= render ui
  where
  ui = createFactory commentBox { url: "/api/comments" , pollInterval: 2000 }
  container = do
    win <- window
    doc <- document win
    fromJust <$> toMaybe <$> getElementById contentId (htmlDocumentToNonElementParentNode doc)
  contentId = ElementId "content"

src/Main.js

"use strict";

// module Main

exports.marked = function(src) {
  return function(opt) {
    return marked(src, opt);
  };
};

function mkProps(props) {
  var result = {};
  for (var i = 0, len = props.length; i < len; i++) {
    var prop = props[i];
    for (var key in prop) {
      if (prop.hasOwnProperty(key)) {
        result[key] = prop[key];
      }
    }
  }
  return result;
};

exports._span = function(props) {
  return React.createElement("div", props.length > 0 ? mkProps(props) : null, null);
};

exports.getTargetValueFromEvent = function(event) {
  return event.target.value;
};

exports.preventDefault = function (e) {
  return function () {
    return e.preventDefault();
  };
};

function fixedEncodeURIComponent (str) {
  return encodeURIComponent(str).replace(/[!'()*]/g, function(c) {
    return '%' + c.charCodeAt(0).toString(16);
  });
}

exports.toFormURLEncoded = function (obj) {
  var key;
  var str = "";
  var first = true;
  for (key in obj) {
    if (obj.hasOwnProperty(key)) {
      if (first) {
        first = false;
      } else {
        str += "&"
      }
      str += fixedEncodeURIComponent(key);
      str += "="
      str += fixedEncodeURIComponent(obj[key])
    }
  }
  return str
}

ファイルを書き込んだ後、

$ pulp build -O -t public/scripts/example.js

とすることで、example.js が置き換わり、完成です。

解説

わぁ、Haskell っぽい。って思ったかと思います。ええ、ほぼ Haskell です。ただ、まんま Haskell と言うわけではなく、ちょっと違いがあります。そこら辺も含めて解説できたらいいかなと思います。¹

purescript-react の基礎

普通の React.js と同じで createClass で ReactClass を作って、createFactory で RecatElement 作って、render で描画します。div とかは import qualified React.DOM as D としておく事で D.div と書けます。つまり、何も変わりません！

とは、単純になりません。本来、render は副作用を伴います。なので、扱いは Effモナドになっています。Effモナドというのは Haskell でいう IOモナドのような物です。餡子を餅でできた皮で包んだお菓子の一種です²。

createClass はさらに注意が必要です。この関数は ReactSpec を受け取って、ReactClass を作成します。ReactSpec を作るために一番一般的なのは spec 関数です。spec は state の初期状態と Render を受け取って ReactSpec を作成します。Render は ReactThis というコンテキスト(state と props を保持している何か)を受け取って Effモナドで包んだ ReactElement を返す関数です。簡単に言えば、do 記法使って、最後の return で ReactElement を返せばいいのです。つまり、ここが render になります。ReactThis からは getProps や readState で props と state を取り出せますが、これらも Effモナドで包まれています。setState のような state の書き換えは writeState を使いますが、これも Effモナドで包まれています。こうして、各副作用がある操作を Effモナドで包み込んで、(それ自体には)副作用が無い ReactClass を作成しています。

render の仕方はわかったけど、componentDidMount とかはどうするのかというと commentBox の所を見てください。spec で作った ReactSpec に後から componentDidMount を設定しているのがわかるかと思います。そう、ReactSpec はただのレコード(JavaScript での Object にあたる)です。なので、一部だけ書き換えということができます。

基礎がわかったところで、ちょっと工夫が必要になったところも紹介しておきます。

props に children などいない

PureScript は強い静的型付けです。Haskell と同じく強力な型推論も持っているし、正しい型注釈はプログラミングの助けにもなります。しかし、それが時には邪魔をします。

comment は本来のReactチュートリアルのソースでは props.children を使っていました。でも、このコードでは使っていません。いえ、使えませんでした。comment の型を見てください。props には children がありません。これは、commentList で comment を作るときに children が渡せないからです。そう、props.children は暗黙的に作成されるため、PureScript 上では存在する物として扱えません！苦肉の策として、props.text としてそのまま子要素と同じ内容を渡しています。

いや、きっとやり方はあるような気がするのですが、私は見つけられませんでした。ここら辺、詳しい人がコメントくれると嬉しいです。

dangerouslySetInnerHTML の罠

上の issue に書いてあるのですが、現行のバージョンでは子要素を null にする方法がないため、そのままでは dangerouslySetInnerHTML を使うとエラーになります。今回は _span という子要素が null になる外部関数を用意しています。ここら辺は、そのうちなおると思います。

ajax は Affjax(purescript-affjax) を使え

PureScript では、IOモナドの代わりに Effモナドを使うのでした。しかし、JavaScript には非同期処理という物があり、Effモナドでは扱いきれません。そこで Affモナドという非同期処理用の IOモナドもどきが用意されています。Affjax はそんな Affモナドを使った ajax です。commentBox で get と post を使っているので見てみてください。

JSON は Argonaut(purescript-argonaut) を使え

PureScript では JSON を扱えるライブラリがいくつかあります。今回は Argonaut を使いました。これは強力な型チェックを行えるため、正しくない JSON の読込を阻止できます。強力な型システムに非常にマッチ・・・しているような気がします。

まとめ

いかがだったでしょうか？ purescript-react はサンプルが非常に少なく、かなり苦労しました。PureScript 自体、まだ安定して利用できるかはちょっと疑問ではありますが、Haskell と同等レベルの強力な型システム、純粋関数型という強み、最後は外部 JavaScript になげればなんとかなる柔軟さ(え？)、と今後目を離せない altJS です。書き慣れてしまえば、React.js を PureScript で作るのもそれほど苦労しませんでした。みなさんもぜひ使ってみてください。

つまり、Haskell がわかる人が前提ってこと、ひでーや。 ↩
それはモナカだろ。 ↩