単純パーセプトロンを実装してみた

年が明けていますが、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サーバー用のパッケージつくってみた

追記

本記事のパッケージは現在メンテされておりません。

サーバー向けパッケージは再実装されたものがこちらにあります。

Bucketchain

はじめに

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の基礎的なことを知っていれば、すぐに使い始めることができるかと思います。 でも、こんな何処の馬の骨かわからんようなもんがつくったものよりも、実績のあるフレームワークがあるので多分誰も使わないでしょう。 私の趣味で作ったので、自分で使い込んでいっていい感じにしていきたいと思います。(飽きる可能性もありますが)

どうやってPureScriptに慣れたのか

はじめに

PureScript Advent Calendar 2017 - Qiitaの1日目の記事が埋まっていなかったので大急ぎで書くことにしました。

元々はRubyやJavaScriptなどの動的言語をメインでメシを食べているプログラミング的ゆとり世代であった私が、 少なくとも一般論としては学習が大変だと評されているPureScriptを、 (上手いか下手かは別として)普通に書けるようになった要因を記憶の限り辿ってみようと思います。

つまり、この記事は、「最初からPureScriptの勉強のためにやっていた」ということではなく、「たまたまそういう道を通ったけど、 あれがよかったのかもしれない」という回想です。

道のはじまり

この道のはじまりはHaskellでした。

特に仕事で使うわけでもなく、関数型言語に興味があったわけでもなく、ただなんとなく暇を持て余していたので暇つぶしとして思いついて勉強し始めました。どうやって勉強していたかというと、いわゆるすごいH本をダラダラ読みながら適宜写経するという方法でした。 この本は、基本的な構文や畳み込み、型クラス、IO、ファンクター、アプリカティブファンクター、いくつかの基本的なモナドなどについて、ゆとりでもわかりやすく書かれていました。どういうものなのか？なんのためにあるのか？ということがある程度はわかった気になれたと思います。

ちなみにこの時点では、基本的に知識の定着はしないですが、雰囲気だけは忘れずに頭に残っている状態になります。 本による勉強ってそんなもんだと思っているので、あまり真剣になりすぎず流し読みするのが良いでしょう。

また、アプリカティブファンクターについては、実用時の想像が頭になく、いったいなんなんだこれは？という感覚をもっていましたが、 Applicativeのススメ - あどけない話を読んだらそれは解消されました。 メリットやアプリカティブスタイルであるときとないときのコードの違いが書かれていて腑に落ちました。

モナドについては、モナドの力がいまいちわかりませんでしたが、

Stateモナドがわかればモナドがわかる - セカイノカタチ と モナドってなんだよ!?全然わからないんで分解して図解してみた(´・ω・`) - セカイノカタチを読んだことによって、理解が進んだように思います。

実際に書きはじめる

Spock

とりあえずフレームワーク使って書いてみようということで、フレームワークを調べました。 初心者の悲しい性ですが、シンプルで素朴な感じのフレームワークはどれだろうか？という視点で調べていてヒットしたのがSpockでした。

はじめたものの、SpockM conn sess st ()←この型を見ても意味不明で、とりあえず理解することを一旦諦めました。 当然意味がなにもわかっておらず、コンパイラに怒られまくっていたのですが、エラーの内容を見て直し続けると、 どういうわけか動いてくれるという不思議な体験をしました。 仕事で静的型付け言語を書いたこともあり、コンパイルエラーのときは常にいらついていた私でしたが、この時に「もしかしてコンパイラって友達なの？」という感覚が芽生えたのは新鮮でした。「俺たちは雰囲気でプログラミングをやっている」という感覚でした。 ここで身についたのは知識というよりも「コンパイラに身を委ねる感覚」だったかなと思います。

Servant

知り合いのHaskellerに「フレームワークは何がいいのか？」と聞いたら、servant – A Type-Level Web DSL — servant documentationだ、ということなので使い始めました。 「型でルーティングするとかまじかっけーな」という小学生並みの感想だったのですが、このフレームワークは私にとってはかなり勉強になりました。

これはドキュメントがお宝だらけだったからだと感じています。例えば、チュートリアルの最初に言語拡張の宣言が書いてあったりするのですが、なんとなく学習していたらお目にかかれないものが山ほど書かれていて、1個1個調べるのは大変でしたが、かなり勉強になりました。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

私はこのServantを土台に、認証、DB操作やプーリング、JSONのレスポンス生成などを試すことによって、上記の言語拡張に加えて、各種モナドトランスフォーマーや自動導出、自然変換など、色々なことを知ることができました。

当初は、とにかくコンパイル通すのに四苦八苦していましたが、 コンパイルエラーのメッセージが尋常じゃないくらい親切だった記憶があり、 コンパイルエラーと戦っているだけで訓練されていっている感覚がありました。 この時は、何かを調べようとすると何かを調べないといけない、みたいな感じになることも多く、一番勉強になった時期だったかと思います。 私はServantで普通のAPIサーバーを書くのはかなり効率のいい学習方法だったように感じています。

Elm

上記のようにHaskellを勉強したのち、フロントエンドも関数型で書いてみたかったのでElmを書き始めました。 Haskellを学習した後にやったためか、頭おかしいくらい学習コスト低いと感じてびっくりしたのを覚えています。

掲示板をつくりかけてみたり、自分のgithubページをElmで書き換えて見たり、Haskellとあわせて個人サービスをつくりかけてみたり、全部途中でやめる程度ではありますが、認証、通信、port、デコード、タイマー、各種イベント、それなりに色々できた感じがします。

Elmは型クラスないので、当然モナドもないのですが、書いていると「あ〜このへんがこうなってるのは副作用が伴う処理だからこんな感じになってるんだよな」みたいな感じのことを考えながら、フロントエンドという分野で、「何にどう型付けしているのか」が結構理解できました。

PureScript

ElmのあとにPureScriptを始めました。やっとPureScriptの話ができます。

と言いたいところですが、実はこのセクションについては書くことがほとんどありません。 もうすでにこの時点で、言語そのものが理由で書くのにつまるということがほとんどなくなっていました。(Effだけちょっとハマったけど)

一応Read PureScript by Example | Leanpubは読みましたが、ほぼ流し読みで、一生懸命読んだのはEffの章とFFIの章くらいです。

話は変わりますが、私はPureScriptをはじめてから型レベル計算を真面目に勉強したのですが、GitHub - paf31/purescript-quickserve: Quick HTTP serversが入門としてかなりわかりやすかったです。 各種エンドポイントでRecordをつくり、そのRecordでルーティングするところを読むと結構理解が進みます。

全体を通してやっていたこと

基本的に移動中は、使おうとしているパッケージを読むということをしていました。大体最初はほとんど読めないし、だるくなって読むのやめたりするのですが、そういうのはあまり気にしません。時間が解決してくれます。必要なのはコードの実態を目で見ることだけで、それさえしておけば、書いているうちに理解が後追いで一気に来ると思います。

最後に

急がば回れではないですが、HaskellとElmを先にやったのは結構よかったんじゃないかと思います。 Haskellは非常に情報量が多く調べやすいこと、そして、PureScriptよりも親切なエラーメッセージがあり、 調査に困らないし、コンパイラが勝手に訓練してくれます。ビシバシと鞭でケツを叩かれている感じで、ﾝｷﾞﾓﾁﾞｲｲｲｲｲｲｲｲｲｲｲｲｲｲｲｲｲｲという感じでしょうか。おそらく、PureScript書く上で、この時の体験が一番大きいです。

また、Elmに関しては、学習コストが低いため、ブラウザという戦場ではどこでどのように型付けしているのか、という世界観をつかむことに集中できます。

それと、学習する時に、いかに適当に雑に頭に入れておくかってことととりあえず書くということをしていれば、とりあえず書けるようになるぶんには、はじめてプログラミングを勉強した時と比べて学習コストが特段高いと感じない気はします。

PureScript興味あるという人は、Haskell と Elmから勉強すると実は近道かもしれません(適当)