せっかくアドベントカレンダーに参加すると言うことで頑張ってみました。なお完成までに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 とかは使わなくなるので除いておきます。
<!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 になります。
-- |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"
"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 と言うわけではなく、ちょっと違いがあります。そこら辺も含めて解説できたらいいかなと思います。1
purescript-react の基礎
普通の React.js と同じで createClass で ReactClass を作って、createFactory で RecatElement 作って、render で描画します。div とかは import qualified React.DOM as D としておく事で D.div と書けます。つまり、何も変わりません！
とは、単純になりません。本来、render は副作用を伴います。なので、扱いは Effモナド になっています。Effモナド というのは Haskell でいう IOモナド のような物です。餡子を餅でできた皮で包んだお菓子の一種です2。
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 で作るのもそれほど苦労しませんでした。みなさんもぜひ使ってみてください。