purescript-conveyorにBatch operationの機能を足した
追記
本記事のパッケージは現在メンテされておりません。
サーバー向けパッケージは再実装されたものがこちらにあります。
はじめに
年が明けてますが、PureScript Advent Calendar 2017 - Qiitaの21日目の記事にしてしまいます。
前回、PureScriptでAPIサーバー用のパッケージつくってみた - oreshinyaのブログというようなAPIフレームワークをつくったことを記事にしましたが、 このフレームワークにBatch opearationの機能を足しました。 また、その際に全面的にソースコードを書き直したため、変更点を書きます。
Batch operationってなに
複数のエンドポイントを1回のリクエストで実行する機能です。
複雑なアプリケーションになると、ひとつの画面に必要なデータが非常に多岐に渡ります。 そのような状況下の中、ひとつのAPIで色々な多くのデータを返すか、単機能なAPIを複数回叩くかという選択をすることを最初に考えるかと思います。 このことに対して、何も対策的な仕組みを入れない場合、前者の場合はUIによりすぎたメンテのしにくいAPIによっていくし、後者は何度もリクエスト往復するのでとても時間がかかります。
こういったことに対して、数年前からBFFという概念が公に出るようになりました。 ただ、気合の入ったBFFをしなくても、単純なbatch operationだけでもあると、経験上、わりと快適になるため、自分で使うためのライトユースとして、この機能を足しました。
Servable
のメンバの型が変わった
変更コミットたちです。
Batch operationを入れるために、Servable
のメンバの型を変えました。
以前の型はserve :: c -> s -> Request -> Response -> String -> Maybe (Eff (http :: HTTP | e) Unit)
で、新しい型はserve :: s -> c -> RawData -> Aff e Responder
になります。
大きな変更点は、返り値の型となります。
以前の型では、serve
の実行文脈の中でレスポンスをクライアントに返すことを期待した型付けでしたが、新しい型では、serve
の文脈でレスポンスとなるデータをつくって返すだけになっています。
新しい型にしたことによって、batch operationの実装は、serve
を指定された各エンドポイントのパラメータの配列を用いて、traverse
して複数のレスポンスをまとめればいいだけになりました。
その他の変更
- Request bodyのdecodeに関しては、purescript-simple-jsonに依存するように変更して、
Readable
型クラスを削除した Respondable
型クラスの全面的な書き直しHandler
を削除して、普通にAff
で動くように変更した- 関数の引数の順番とか数とか引数そのものを地味に変えた
- まぁ、なんか色々書き直した
まだ改善できるところはある
現状は、各エンドポイントを順番に処理してるだけなので、concurrentに実行できるようにするとよりよさそうです。
使い方
Servable
のインスタンスをBatch
型で包んで初期化すれば、OKです。
リポジトリのサンプルコードとほぼコピペですが、以下のような感じで初期化します。
runWithContext config 777 $ Batch { contextTest, errorTest, rawDataTest, createBlog }
以下のようなデータをrequestのbodyとして、POST /batch
におくりつけると、
[ {"path": "errorTest"}, {"path": "contextTest"}, {"path": "createBlog", "body": { "title": "hoge", "content": "うんち in batch" }}, {"path": "rawDataTest", "body": "ろーでーた"} ]
以下のようにかえってきます。
[ { "contentType": "application/json", "code": 500, "body": { "messages": [ "Internal server error ;)" ] } }, { "contentType": "application/json", "code": 200, "body": { "yours": "777" } }, { "contentType": "application/json", "code": 200, "body": { "fuck": "title: hoge, content: うんち in batch requested." } }, { "contentType": "application/json", "code": 200, "body": { "yours": "\"ろーでーた\"" } } ]
単純パーセプトロンを実装してみた
年が明けていますが、PureScript Advent Calendar 2017 - Qiitaの20日目の記事にしてしまいます。
Python機械学習プログラミングを2章まで読んだ。
読んだ内容を体にいれるために、適当にPureScriptで単純パーセプトロンを実装してみる。
module Main where import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.State (StateT, execStateT, get, modify, put) import Control.Safely (replicateM_) import Data.Array (snoc, zipWith) import Data.Foldable (sum) import Data.Traversable (for) import Data.Tuple (Tuple(..)) -- 学習によって更新されていく値 type State = { weights :: Array Number , bias :: Number , errors :: Array Number } main :: forall e. Eff (console :: CONSOLE | e) Unit main = do -- 学習率は0.01とし、エポック数は10としてみる state <- flip execStateT initialState $ fit 0.01 10 log $ "expected: 1.0, gotten: " <> (show $ predict $ netInput [1.0, 1.0] state) log $ "expected: -1.0, gotten: " <> (show $ predict $ netInput [0.0, 1.0] state) log $ "expected: -1.0, gotten: " <> (show $ predict $ netInput [1.0, 0.0] state) log $ "expected: -1.0, gotten: " <> (show $ predict $ netInput [0.0, 0.0] state) log $ "weights: " <> show state.weights log $ "bias: " <> show state.bias log $ "errors: " <> show state.errors -- 学習 fit :: forall e. Number -> Int -> StateT State (Eff e) Unit fit eta iter = replicateM_ iter do errors <- for samples \(Tuple xs y) -> do st <- get let d = eta * (y - predict (netInput xs st)) put $ st { weights = zipWith (+) st.weights $ map ((*) d) xs , bias = st.bias + d } pure d -- イテレーションごとに雑に誤差をいれておく modify \s -> s { errors = snoc s.errors $ sum errors } -- ステップ関数 predict :: Number -> Number predict z = if z >= 0.0 then 1.0 else -1.0 -- 総入力 netInput :: Array Number -> State -> Number netInput xs { weights, bias } = bias + (sum $ zipWith (*) xs weights) -- 初期状態 initialState :: State initialState = { weights: [ 0.0, 0.0 ] , bias: 0.0 , errors: [] } -- サンプル -- 特徴量と期待する出力 samples :: Array (Tuple (Array Number) Number) samples = [ Tuple [ 0.0, 0.0 ] (-1.0) , Tuple [ 0.0, 1.0 ] (-1.0) , Tuple [ 1.0, 0.0 ] (-1.0) , Tuple [ 1.0, 1.0 ] 1.0 ]
今回はAND演算を学習させてみた。
実行してみる。
expected: 1.0, gotten: 1.0 expected: -1.0, gotten: -1.0 expected: -1.0, gotten: -1.0 expected: -1.0, gotten: -1.0 weights: [0.04,0.02] bias: -0.06 errors: [0.0,-0.02,-0.02,0.0,-0.02,0.0,0.0,0.0,0.0,0.0]
6回目から誤差が出なくなっているっぽい。
ADALINEも実装しようと思ったが、飽きたので一旦終了。
Elm Architectureのポエム
はじめに
Elm2 Advent Calendarの11日目の記事です。
1文字もコードが出てこない上、主観的なことを書いたポエムです。 Elmを一時期触ってた者として感じていたことを思いつきで書きたくなったので書きます。
Elmの売りポイントと解釈しうるもの
(Elm好きな人からすると色々あるのかもしれないけど、)端的に言うと、やっぱり、Elm Architectureという決まったアーキテクチャを強制されることなんじゃないかなーと思います。
ウェブサービスでリッチさが求められる頻度が増えてきたのはここ数年で始まった潮流だと勝手に思っているので、ウェブエンジニアにGUIアーキテクチャに強い人は割と少ないという主観的な所感をもっています。
いわゆるウェブエンジニアという人たちの多くの主戦場はサーバーサイドの人が多いと感じていて(私の観測範囲が偏っているかも?)、そのようなエンジニアにGUIを真面目に勉強しようという人の母数がすくないということ、また、勉強していたとしてもそれらを参考にした上で初期からよく考えて基盤をつくった結果、時間がたってから「あ〜これは失敗したな〜」という経験まである人はかなり少ない、更に言えば、そういった経験を複数回している人はもっと少ないだろうな、という推測からこのように考えています。
あるいは、フロントエンドにすごく興味があったとしても、多くの人間は、アーキテクチャがちゃんと考えられていないあるいはそもそもそんな概念すらない既存のフロントエンドのコードに引きづられて諦観をもって適当なコードを書きながらメンテしつつ「ぼくのかんがえたさいきょうのあーきてくちゃ」を夢見て社会人やってるって状況もそれなりに多いのではないかなとも思っています。
そして、どんな分野でも、考えた末の失敗経験があるかないかってのは大きな差があると思うんですよね。
つまり、ウェブエンジニアでGUIアーキテクチャに自信ニキってまだ少数派なんじゃないかと思うわけです。アーキテクチャは自分で取捨選択して考えてつくる条件下の場合、下手するとiOSとかAndroidエンジニアに書かせた方がいい設計でつくってくれる人多いんじゃないかと思ってしまうくらいです。
で、そういった私の勝手な主観が真実であると仮定した場合、副作用が隠蔽され勝手に変なところに処理を書けないように型で守られている、という前提の元に強制される1つのアーキテクチャが最初からついてくるっていうのは、かなり強い強制力であり、著しく思慮の浅い設計でコードを書かれるというありがちなリスクをつぶせるので、大きなアドバンテージのように思います。
でも、Elm Architectureよくわかんないってばよ
こういう人は一定数いるかもしれません。しかし、むしろElm Architectureよくわかんないっていう人ほど、Elmは、リッチなアプリケーションをつくるときの有力な選択肢になると私は考えています。 理由は、そもそもElm Architectureの理解に苦しむ人は、基本的にはGUIアーキテクチャに自信ニキではないことのほうが多いと思うので、なら他人が考えたアーキテクチャ(つまりElm Architecture)を強制された方がいいよね、と思うからです。
最後に
一応言っておくと、私が今回書きたかったのはElm Architectureの良し悪しではないですし、マンセーする意図はありません。
ただ、そもそも強制されるArchitectureが存在するということ自体が大きなアドバンテージになるという考え方はあるよね、ってことです。
そう考えると、Elmは実に仕事向けな言語かもしれないなぁと思いました。(小並感)
PureScriptでAPIサーバー用のパッケージつくってみた
追記
本記事のパッケージは現在メンテされておりません。
サーバー向けパッケージは再実装されたものがこちらにあります。
はじめに
https://github.com/Bucketchain PureScript Advent Calendar 2017 - Qiitaの10日目の記事です。
今年、APIサーバー用のパッケージを書いてみたので、それについて書きます。
結構前につくったものですが、Advent Calendar用のネタもそんなに持ってないので、これについて書くことにします。
なぜつくったのか
そもそもPureScriptでサーバー書こうという人がほとんどいないためか、サーバー用のパッケージはかなり少ないです。 (たぶん)有名なところで言うとhyperやquickserveがありますが、それらも比較的最近つくられたものです。 あとは、node-httpなどの生のnodeのAPIをPureScriptで呼べるようにしたものくらいしかありませんでした。
そういうわけで、めんどくさそうだけどどうせ趣味でやってるだけだし勉強にはなるだろうということで私もつくってみることにしました。
ざっくりどんなものか
オレオレRPCです。具体的には以下のような制約になります。
- POSTしか受け付けない
- 呼び出したい処理はpathで指定する
RESTが広く浸透している世界ですが、そもそも「なるべくREST守ろう」という振る舞いが見られない人もいれば、REST頑張ろうとしている人間の頭の中に「各々にとっての正しいREST」があり、とりわけ「Resourceとは何なのか」ってところが人間によってブレている 、などの様々な事象が原因で「人間にRESTは結構難しいなー」という感想があります。
私はそのことについては「人間なのでしょうがない」とは思っていますが、そのことについてやりとりするのは正直飽きたし、どうでもよくなってしまいました。若者のREST疲れってやつです。(若いとは言ってない)
そのような背景がある上で、RPCでも私が当時よく見かけてたのは、pathは/
のみで、呼び出したい処理はbodyで指定するという形でした。
たとえば、JSON-RPC 2.0 Specificationだったり、DynamoDB や Route53 などの AWS API が独特な仕様なので紹介 - Qiitaだったりでしょうか。
しかし、とりあえず自分が使えれば良いということと、内部実装上で少し手抜きをしたことで上記のような形となりました。これは
他人に受け入れられにくい制約なので、SSKDsなAPIにしか使いにくいと思われます。
以下がつくったパッケージです。
ここからは簡単に使い方を説明します。
レスポンスの型を用意する
import Control.Monad.Eff.Exception (message) import Conveyor.Respondable (class Respondable) import Simple.JSON (class WriteForeign, writeJSON) data Result r = Success { status :: Int, body :: r } | Failure { status :: Int, messages :: Array String } instance respondableResult :: WriteForeign r => Respondable (Result r) where contentType _ = "application/json" statusCode (Success s) = s.status statusCode (Failure f) = f.status encodeBody (Success s) = writeJSON s.body encodeBody (Failure f) = writeJSON f.messages systemError err = Failure { status: 500, messages: [ message err ] }
例えば、こんな感じです。Respondable
型クラスのインスタンスにしましょう。Success
のbodyはWriteForeign
のインスタンスであればオッケーな感じにしてみました。
実際には、必ず決まったJSONフォーマットにするシリアライザの仕組みを使ってencodeBody
を実装するといいと思います。
何かデータを返すだけの処理をつくってみる
import Conveyor.Handler (Handler) newtype Book = Book { id :: Int, title :: String } derive newtype instance writeForeignBook :: WriteForeign Book getBooks :: forall e. Handler e (Result (Array Book)) getBooks = pure $ Success { status: 200, body: books } where books = [ Book { id: 1, title: "Book 1" } , Book { id: 2, title: "Book 2" } ]
本の配列を返します。Book
がエンコードできるようにWriteForeign
のインスタンスにしました。
各種pathに反応する処理は、このパッケージが提供するHandler
モナドを使って記述します。
Nodeがバックエンドなので非同期処理が満載になるはずなので、Handler
はAff
のnewtype
にしました。
Bodyを受け取る処理をつくってみる
import Conveyor.Body (Body(..)) import Conveyor.Readable (class Readable) import Simple.JSON (class ReadForeign, class WriteForeign, readJSON', writeJSON) derive newtype instance readForeignBook :: ReadForeign Book instance readableBook :: Readable Book where readBody = readJSON' createBook :: forall e. Body Book -> Handler e (Result Book) createBook (Body book) = pure $ Success { status: 201, body: book }
さきほど定義したBook
型をrequest bodyとして受け取れるようにしてみました。Readable
型クラスのインスタンスにし、関数の引数をBody Book
とすればOKです。
ここの例では、readBody
の実装はSimple-JSONに任せてしまいました。
エラーが起こる処理をつくってみる
import Control.Monad.Eff.Exception (error, message) import Control.Monad.Error.Class (throwError) alwaysError :: forall e. Handler e (Result Book) alwaysError = throwError $ error "Always Error !!!"
とりあえず意図的にthrowError
を使ってエラーを起こしてみます。
サーバーを立ち上げてみる
import Prelude import Control.Monad.Eff (Eff) import Conveyor (run) import Data.Maybe (Maybe(..)) import Node.HTTP (HTTP) main :: Eff (http :: HTTP) Unit main = run routes config where routes = { getBooks, createBook, alwaysError } config = { hostname: "0.0.0.0", port: 3000, backlog: Nothing }
run
関数に適当なconfigとルーティングを渡します。ルーティングはさきほどつくったHandler
を単にRecordを渡せばOKです。
pulp run
して、リクエストを送ると以下のように返ってきます。
POST localhost:3000/getBooks => [ { "title": "Book 1", "id": 1 }, { "title": "Book 2", "id": 2 } ] POST localhost:3000/createBook (適当なidとtitleをもったJSONをrequest bodyに渡す) => { "title": "hoge", "id": 3 } POST localhost:3000/alwaysError => [ "Always Error !!!" ]
値の共有をする
例えば、コネクションプールなど、サーバー起動時に生成したものを持ち回りたい、とかそういうお気持ちはあると思います。 そのための仕組みも一応用意してあります。
import Conveyor (runWithContext) import Conveyor.Context (Context(..)) -- その他色々モジュールインポート createBook :: forall e. Context Pool -> Body Book -> Handler (mysql :: MYSQL | e) (Result Book) createBook (Context pool) (Body book) = -- 省略 main :: Eff (http :: HTTP, mysql :: MYSQL) Unit main = do pool <- createPool runWithContext pool routes config where routes = { getBooks, createBook, alwaysError } config = { hostname: "0.0.0.0", port: 3000, backlog: Nothing }
このようにrunWithContext
で好きな値を渡しておくと、関数側の引数でContext
を指定すれば取り出せるようになっています。
もっと違う形で大域変数っぽいものを持ちたければ、Servable
という型クラスを提供しているので、好きなモナドスタックのnewtypeをつくって、Servable
のインスタンスにすれば好きなようにできます。パッケージ側ではServable
のインスタンスはこのくらいしか提供してないです :)
最後に
現在の実装はかなりquickserveをパクり(ry...参考にして作られているのですが、型クラスの使い方が結構勉強になりました :)
PureScriptの得新型実態
はじめに
PureScript Advent Calendar 2017 - Qiitaの8日目の記事です。 今日は「得新型実態」について書きます。
「得新型実態」ってなによ
derive newtype instance
のことを指しています。面白いと思って全部漢字にしてみたんですけど、次の日に見たら恥ずかくなって消すかもしれません。
そもそもnewtypeってなんやねん
PureScriptで代数的データ型を定義する時は、例えば、以下のように定義すると思います。
data HumanValue = Money Int | Personality | Face | Body
newtype
は上記とは別の意味をもった型宣言のやりかたです。ある型を別の型に見せかけたい、というような時に使います。
newtype Money = Money Int
これで、Money
型とInt
型は、コンパイル時に別の型として扱われます。
さて、このnewtype
宣言には「値コンストラクタは1つで、それが持てる値も1つだけ」という制約があります。
ハンターハンターで覚えたんですが、制約があるってことはその代わりに良いことがあるみたいです。(全然関係ないけど、自分に特殊能力があることを期待して、水見式やったことある人、いると思います。)
以下のコードを見てください。
newtype FirstName = FirstName String data LastName = LastName String foo :: FirstName foo = FirstName "foo" bar :: LastName bar = LastName "bar"
これをコンパイルするとこのようになります。
var LastName = (function () { function LastName(value0) { this.value0 = value0; }; LastName.create = function (value0) { return new LastName(value0); }; return LastName; })(); var FirstName = function (x) { return x; }; var foo = "foo"; var bar = new LastName("bar");
data
で宣言したものはゴニョゴニョと処理があるのに対して、newtype
で宣言した型は、ランタイム上ではnewtype
の中身の型として扱われています。
こう見ると、余計なことしない分、newtype
のほうがパフォーマンスはよさそうですね。これは制約によりもたらされた良いことの1つと言えるでしょう(実感として、この差にどのくらいありがたみを感じるかはアプリケーションによりますが)。
しかしながら、この「ランタイムとしては同じ型として扱われること」によって、もう1つ良いことが発生します。
ということで、次のセクションへ進みます。
derive newtype instance
さて、このnewtype
ですが、こいつをなんらかの型クラスのインスタンスにしたい時ってありますよね?
例として、上述したFirstName
型をEq
のインスタンスにしたいお気持ちが湧いてきたとしましょう。
instance eqFirstName :: Eq FirstName where eq (FirstName s1) (FirstName s2) = eq s1 s2
こんな感じでインスタンスにできますね。
ただ、ちょっと待って欲しい。FirstName
は単にString
をくるんだだけで、かつ、String
はEq
のインスタンスです。
「なんで俺が温もりのある手作業でeq
を定義しなければいけないんだ!なんかもっといい感じにできそうな雰囲気あるだろうが!」
このように思う人はいるはずです。
そんなときにはderive newtype instance
の出番です。
derive newtype instance eqFirstName :: Eq FirstName
あーら不思議、eq
の定義をせずに済みました。これはランタイム上ではnewtype
の値コンストラクタの中身の型と同じ扱いであることによって実現できています。
さらには、こんな型があるとします。
newtype App eff a = App (StateT Int (ExceptT String (Eff eff)) a)
上のEq
の例だけ見ると手作業が許せるかもしれませんが、この例を見ると、さすがにこの型を手作業で各種型クラスのインスタンスにするのはうんざりしそうですね。
derive newtype instance functorApp :: Functor (App eff) derive newtype instance applyApp :: Apply (App eff) derive newtype instance applicativeApp :: Applicative (App eff) derive newtype instance bindApp :: Bind (App eff) derive newtype instance monadApp :: Monad (App eff)
これで万事OKです。人間の幸福度が少し上がりましたね。
これが制約によりもたらされたもう一つの良いことです。
最後に
みなさんは6系統の念能力のどれに憧れましたか?
私は具現化系でした。
PureScriptの孤児
はじめに
PureScript Advent Calendar 2017 - Qiitaの6日目の記事です。
小ネタです。
Orphan instanceって何よ
以下のコードをみてください。
instance showUnit :: Show Unit where show _ = ""
ビルドしてみます。
Type class instance showUnit for Data.Show.Show Unit is an orphan instance. An orphan instance is one which is defined in a module that is unrelated to either the class or the collection of data types that the instance is defined for. Consider moving the instance, if possible, or using a newtype wrapper.
これはOrphan instanceだ、と怒られていますね。
これは何かというと、インスタンス定義したモジュールが、型クラスを定義したモジュールでもなければ、インスタンスにしたいデータ型を定義したモジュールでもない場合のインスタンスを指しているようです。
Orphan instanceはPureScriptでは禁止されていて、コンパイルに失敗します。
確かにこの制約がない場合、どこで何のインスタンスが定義されているのかわけわからなくなりそうですね。定義が重複したりもしそうです。これを人間の脳で気をつけるのは大変そうです。
パッケージ提供者が型クラスを提供する場合は、必要なプリミティブ、また、その型クラスにおいてよく使用されるとみなせる型について、インスタンス定義をしておくと親切ということなのだろう。
こんな風に怒られたらどうするの?
エラーメッセージに書いてある通りですね。 「おまえはこういう理由でまちがっている」だけじゃなくて「こうしてくれ」まで書かれていました。
Consider moving the instance, if possible, or using a newtype wrapper
まとめ
人間同士の指摘も、「おまえはまちがっている」だけじゃなくて「おまえはこういう理由でまちがっているのでこうしてくれ」まで言えるとコミュニケーションコスト減ると思います。
PureScriptで意識の低いSPA用パッケージをつくりました
追記
本記事のパッケージは現在メンテされておりません。 代わりのUIパッケージとして書き直したこちらを是非チェックしてみてください。 purescript-freedom
はじめに
PureScript Advent Calendar 2017 - Qiitaの3日目の記事です。 今年につくった、意識の低いSPA用パッケージであるGitHub - oreshinya/purescript-cherry: No longer maintenanceを紹介させていただきます。
使い方
カウンターを例に書いていきます。
State
を定義しましょう
type State = { count :: Int } initialState :: State initialState = { count: 0 }
State
はアプリケーションが抱える状態です。昨今ではおなじみのSingle sourceです。アプリケーション全体の状態を管理します。
カウンターなので、count
という状態を持たせることにしてみます。
Store
をつくりましょう
import Prelude import Cherry.Store as S import Control.Monad.Eff (Eff) import Control.Monad.Eff.Ref (REF) store :: forall e. S.Store (ref :: REF | e) State store = S.createStore initialState select :: forall e a. (State -> a) -> Eff (ref :: REF | e) a select = S.select store reduce :: forall e. (State -> State) -> Eff (ref :: REF | e) Unit reduce = S.reduce store
3つの関数を定義しました。ひとつはstore
です。さきほど定義したinitialState
を使って初期化しています。
select
とreduce
は両方ともアプリケーション内でStore
から状態を取得、あるいは、状態を変更するために必要な関数となります。
それぞれ、State -> a
、State -> State
といった型の関数を渡してもらうことになります。
それぞれSelector
、Reducer
と呼ぶことにします。
Router
をつくりましょう
import Prelude import Cherry.Router (router) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Ref (REF) import Data.Maybe (fromMaybe) import DOM (DOM) import Rout (match, end) data Route = Home | NotFound type State = { count :: Int , route :: Route } initialState :: State initialState = { count: 0 , route: Home } detectRoute :: String -> Route detectRoute url = fromMaybe NotFound $ match url $ Home <$ end route :: forall e. Eff (dom :: DOM, ref :: REF | e) Unit route = router change where change url = reduce $ _ { route = detectRoute url }
まずRoute
型を定義します。ホーム画面と404画面があるという想定で書いています。
そして、ルートの情報を管理しないといけなくなったので、さきほど定義したState
やinitialState
に修正を入れています。
detectRoute
は、urlからRoute
型をつくります。実装については、purescript-routを使って行なっています。
ここでは細かい使い方は割愛します。
route
はルーターの宣言です。change
関数は先ほど定義したreduce
を通してState
のroute
を更新します。
このルーターは後々アプリケーションの初期化時に使います。
View
をつくりましょう
import Cherry.Router as R import VOM (VNode, h, t, (:=), (~>)) home :: forall e. Int -> VNode (dom :: DOM, ref :: REF, history :: HISTORY | e) home count = h "div" [] [ h "h1" [] [ t "Home" ] , h "div" [] [ t $ show count ] , h "a" [ "onClick" ~> (const $ R.navigateTo "/not_found") ] [ t "404 Not Found" ] ] notFound :: forall e. VNode e notFound = h "div" [] [ h "h1" [] [ t "404" ] , h "a" [ "href" := "https://github.com/oreshinya/purescript-cherry", "target" := "_blank" ] [ t "Github" ] ] view :: forall e. State -> VNode (dom :: DOM, ref :: REF, history :: HISTORY | e) view state = case state.route of Home -> home state.count NotFound -> notFound
ホーム画面と404画面を定義しています。最後のview
関数でroute
によって、画面を切り替えています。このview
関数は後々アプリケーションの初期化時に使います。
コード中に出てくるVNode
型は仮想DOMの型で、purescript-vomによって提供されています。
ここでは細かい使い方は割愛します。
Reducer
をつくりましょう
incr :: State -> State incr s = s { count = s.count + 1 }
カウントを増やせるようにするために、incr
関数をつくりました。
Action
をつくりましょう
increment :: forall e. Eff (ref :: REF | e) Unit increment = reduce incr home :: forall e. Int -> VNode (dom :: DOM, ref :: REF, history :: HISTORY | e) home count = h "div" [] [ h "h1" [] [ t "Home" ] , h "div" [ "onClick" ~> const increment ] [ t $ show count ] , h "a" [ "onClick" ~> (const $ R.navigateTo "/not_found") ] [ t "404 Not Found" ] ]
便宜上、Action
と命名していますが、呼び名はなんでもよいです。
このレイヤーは、ユーザー操作から実際の状態変更の間を請け負うレイヤーです。
ここでは、もっとも簡単な例として、さきほどのincr
をreduce
に渡すだけのincrement
を作りました。
実際には、このレイヤーでは、affjaxなどをつかって通信を送り、結果をまってからreduceするなど、
いくらかの副作用を伴った処理になるでしょう。今回は使用しませんでしたが、上述したselect
関数もここで使われるような想定です。
つくったAction
をホーム画面で使います。
これでカウントアップできるようになりました。
初期化しましょう
import Cherry (mount) import Cherry.Renderer (createRenderer) main :: Eff (dom :: DOM, ref :: REF, history :: HISTORY, console :: CONSOLE) Unit main = do renderer <- createRenderer "#app" view mount store renderer [ route ]
これまでにつくったview
を用いて、renderer
をつくり、store
、route
と合わせて、アプリケーションをマウントします。
mount
の最後の引数は、マウント時に一度だけ発火するEff
の配列を渡します。
reduce
を通して状態を変更すると、viewが差分更新するようになります。
全体的にはこんな感じ
module Main where import Prelude import Cherry (mount) import Cherry.Renderer (createRenderer) import Cherry.Router as R import Cherry.Store as S import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Ref (REF) import DOM (DOM) import DOM.HTML.Types (HISTORY) import Data.Maybe (fromMaybe) import Rout (match, end) import VOM (VNode, h, t, (:=), (~>)) data Route = Home | NotFound type State = { count :: Int , route :: Route } initialState :: State initialState = { count: 0 , route: Home } store :: forall e. S.Store (ref :: REF | e) State store = S.createStore initialState select :: forall e a. (State -> a) -> Eff (ref :: REF | e) a select = S.select store reduce :: forall e. (State -> State) -> Eff (ref :: REF | e) Unit reduce = S.reduce store detectRoute :: String -> Route detectRoute url = fromMaybe NotFound $ match url $ Home <$ end route :: forall e. Eff (dom :: DOM, ref :: REF | e) Unit route = R.router change where change url = reduce $ _ { route = detectRoute url } home :: forall e. Int -> VNode (dom :: DOM, ref :: REF, history :: HISTORY | e) home count = h "div" [] [ h "h1" [] [ t "Home" ] , h "div" [ "onClick" ~> const increment ] [ t $ show count ] , h "a" [ "onClick" ~> (const $ R.navigateTo "/not_found") ] [ t "404 Not Found" ] ] notFound :: forall e. VNode e notFound = h "div" [] [ h "h1" [] [ t "404" ] , h "a" [ "href" := "https://github.com/oreshinya/purescript-cherry", "target" := "_blank" ] [ t "Github" ] ] view :: forall e. State -> VNode (dom :: DOM, ref :: REF, history :: HISTORY | e) view state = case state.route of Home -> home state.count NotFound -> notFound incr :: State -> State incr s = s { count = s.count + 1 } increment :: forall e. Eff (ref :: REF | e) Unit increment = reduce incr main :: Eff (dom :: DOM, ref :: REF, history :: HISTORY, console :: CONSOLE) Unit main = do renderer <- createRenderer "#app" view mount store renderer [ route ]
リポジトリのサンプルにも似たようなサンプルコードをのせています。そちらのほうがもうちょっとサンプルとしてバリエーションがあります :)
なぜつくったか
もともとはpuxを使おうとしていたのですが、まずは以下をみてください。
data Event = Increment | Decrement -- | Return a new state (and effects) from each event foldp :: ∀ fx. Event -> State -> EffModel State Event fx foldp Increment n = { state: n + 1, effects: [] } foldp Decrement n = { state: n - 1, effects: [] } -- | Return markup from the state view :: State -> HTML Event view count = div do button #! onClick (const Increment) $ text "Increment" span $ text (show count) button #! onClick (const Decrement) $ text "Decrement"
ある状態遷移をしたいときは、まずEvent
を定義し、foldp
に足したEvent
について行う処理を足していく、というような形になっていて、Event
とその処理に分割されています。(てかほぼElm Architectureなんですけど)
そして、実際のアプリケーションでは、これらの処理は縦にずらーっと並ぶような形になります。
あまり見目麗しくはないので、私はできればこれを避けたいと考えました。
もっと言えば、このEvent
とかいうものを定義したくないと思いました。
この構造は、実際にフレームワークをunsafeな処理をいれずにつくろうとしたら自然にこうなった記憶があるのでたぶん必然的な構造ではあると思うのですが、 一旦そういった言語とか実装の都合は置いといて、この構造について単なる構造的なメリットを考えると、time travel debugging時(puxにそういうのあるか知らないけど)に操作に名前がついていてみやすいということ、そしてもう一つは、理屈上は1つのイベントに対して複数の処理をひもづけられることということかと思います。
Event
をなくすとなると、
前者のメリットがなくなることについては、少しデメリットなのですが、ジェーエスでreduxをやっていたときの感想として、私はtime travel debuggingはたまにしかやらないうえ、イベント名をほとんどみないタイプだったのでそんなに困んなそうだなと思ったこと(ちなみにcherryはまだtime travel debuggingを提供していないです)、
後者のメリットがなくなることについても、まず滅多にそんなことやらなくて、わりと複雑めなSPAで基盤的処理にちょっとだけこの性質を利用したことがあるという程度なので、困らなそうだなと思ったこと、
から、Event
排除の方向でいくことにしました。
JS界隈でreduxの流れから、ducksやrepatch、redux-zeroが出てきているのですが、たぶん発想の源流は似たようなもんなのではないかなと考えています。
そして、ゆとりプログラマらしい発想で、StoreにState
のRef
を持たせたものを内部的にunsafePerformEffでつくることによって、main関数の流れから外れているところでも同じstoreを参照できる、という構造にし、Event
定義をせずにすむようにしました。
最後に
このフレームワークは、巧妙な型を使ってできているというわけではないので、PureScriptの基礎的なことを知っていれば、すぐに使い始めることができるかと思います。 でも、こんな何処の馬の骨かわからんようなもんがつくったものよりも、実績のあるフレームワークがあるので多分誰も使わないでしょう。 私の趣味で作ったので、自分で使い込んでいっていい感じにしていきたいと思います。(飽きる可能性もありますが)