複雑なアプリケーションになると、ひとつの画面に必要なデータが非常に多岐に渡ります。そのような状況下の中、ひとつの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": "\"ろーでーた\""
        }
    }
]

2018-01-05

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

年が明けていますが、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も実装しようと思ったが、飽きたので一旦終了。

2017-12-11

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は実に仕事向けな言語かもしれないなぁと思いました。（小並感）

2017-12-10

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にしか使いにくいと思われます。

以下がつくったパッケージです。

purescript-conveyor

ここからは簡単に使い方を説明します。

レスポンスの型を用意する

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...参考にして作られているのですが、型クラスの使い方が結構勉強になりました :)

2017-12-08

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系統の念能力のどれに憧れましたか？

私は具現化系でした。

はじめに

紹介

さいごに

はじめに

Batch operationってなに

Servableのメンバの型が変わった

その他の変更

まだ改善できるところはある

使い方

はじめに

Elmの売りポイントと解釈しうるもの

でも、Elm Architectureよくわかんないってばよ

最後に

はじめに

なぜつくったのか

ざっくりどんなものか

レスポンスの型を用意する

何かデータを返すだけの処理をつくってみる

Bodyを受け取る処理をつくってみる

エラーが起こる処理をつくってみる

サーバーを立ち上げてみる

値の共有をする

最後に

はじめに

「得新型実態」ってなによ

そもそもnewtypeってなんやねん

derive newtype instance

最後に

`Servable`のメンバの型が変わった

`derive newtype instance`