Chefのあれこれ #pfcasual

昨日Provisioning Frameworks Casual Talks vol.1というイベントに参加した。イベントの内容はスライドも上がってるだろうし割愛して、今の状況や思うことなどを書いてみよう。

前提として、現職での管理対象のサーバは少なくて仮想サーバを含めてせいぜい40台程度。各人が使う開発マシンとバッチ処理が走っているマシンが半々くらい。残りは雑多な用途とproductionが数台。web系の会社と比べると極端にproductionサーバが少ないと思う。僕が入社するまではお手製のセットアップスクリプトで諸々の設定をしていたようだ。

chef-solo vs. chef-server

サーバ台数はさほど多くないがchef-serverを使っていて、chef-clientを常時起動させて30分ごとにsyncするようにしている。productionサーバについてはかなり慎重に設定する必要があるのと台数が少ないのでchef-soloを使って手動で1台ずつ反映している。

この構成を選んだ理由は幾つかある。

• 前職でchef-serverを使っていたので扱いに慣れている
• いわゆる「サーバ管理ツール」を持ってないので、chef-serverのweb UIがあると便利
• 一部のサーバがとても遅いVPN接続の向こうにあるので、手動でのデプロイ作業は時間がかかってストレスフル
• production以外のサーバは、事故が起きてもまあクリティカルではない

良く言われるセットアップの手間は、Ubuntuを使っていれば公式apt repositoryが使えるため苦にならない。chef-serverのweb UIはお世辞にも使いやすいとはいえないけれども、使えないほど悪くない。

逆に悪い点は、常時起動しているchef-clientの品質があまりよくなさそうなこと。突然死していることがよくあるし、メモリリークしているのか知らないがresidentで1 GB使っていることがよくある。たいていのマシンでは1 GB余分に使われても大丈夫なくらいメモリを積んでいるけど、メモリ割り当ての少ない仮想ホストでは悲しい。カジュアルに再起動しましょうということなんだろうか。

もう一つ思い出した。chef-serverの冗長化はしてないが壊れても悲惨なことにはならないので、作り直せばいいかなと思っている。

テスト

chef-server + chef-client常時起動だとテストが大事になるのだけど、これがあまりできていない。現状でやっているのはJenkinsでknife cookbook testを回しているのと、environmentsを使ってproductionとdevelopmentに分けてdevelopmentで確認する程度。なんどかdata bagsがenvironmentsごとに分かれて無くて嵌った気もする。

一月ほど前にtest-kitchenを試してみたのだけど、READMEの通りでは動かなくて調べる時間が無くて放置している。タイムラインを見る限りちゃんと使っている人が居るようなので、また時間を取って試してみたい。

serverspecについては単体では良さそうに見えた。Chefと組み合わせることについての是非は純正ツールと比較してみないとちょっとわからないなという印象。

Chef vs. Puppet

Puppetは前職で数年前に少しだけ使っていた。id:antipopさんは外部DSL・内部DSLはあんまり関係ないと仰っていたけど、当時は個人的にはそこが一番クリティカルだった。文法自体はもちろん文法エラーもわかりにくい、言語の自由度が低いなど。詳しく覚えてないし、今は改善されているのかもしれない。

今でこそprovisioning frameworkはidempotencyが命だ！と叫ばれているけど、当時PuppetはdeclarativeでChefはimperativeみたいな風潮があったのは、この制限された文法によるところが大きかったのではとも思う。もちろん制限がきつすぎるとexecの嵐になって単なるシェルスクリプトになってしまうんだけど。

結論は特にない。楽できそうな方を使えば良いんじゃないかと思う。

良かったところメモ

イベントで新しく知ったことをメモ。

• id:naoyaさん
  • テストの話がよかった
  • customink/strainer · GitHub
    • 要調査な感じ
• @sethvargoさん
  • mpasternacki/knife-dwim · GitHub
    • cookbookのアップロードに使う。便利そうなのでお世話になると思う。
  • jonlives/knife-spork · GitHub
    • jabberに通知したり、忘れがちなversion bumpもコマンドからできる。これもお世話になりそう。
  • jonlives/knife-flip · GitHub
    • 特定のホストのenviromentを切り替える。便利そう。

事前登録なしについて

最後に登録なしのイベントについては、僕はいいんじゃないかなと思いました。主催者の負担を少なくして継続開催するのが開催側・参加者側双方にとっていいという理由です。

FRPの話

Haskell Advent Calender 2012で久々にブログを書くということで、ついでにはてなダイアリーからはてなブログに移行してみた。記事やコメントはもちろんのこと、はてブも移行でき、なおかつundoもできるという素晴らしい仕様なので、安心して移行することができた。

さて、今回はFunctional Reactive Programming（FRP）の話。FRPとは、時間やシステム外部からの入力に対して応答するプログラムを関数的に表現する方法とでも言えばよいだろうか。

FRPというとまだ定番の実装もなく、実用にはほど遠いと考える人もいるかもしれない。実際、FRPの実装に関してはまだいろいろ研究・改良の余地があるとは思うものの、以前のように簡単にメモリリークするようなことも無く、最近では試してなるほど便利そうと思える段階にまでは洗練されてきていると思う。

FRPが登場してからの15年、駆け足で紹介してみようと思う。説明のしやすさから時間関係は前後しているのはご了承を。

時間変化する値

FRPが最初に出てきたのは今から15年前の1997年、Conal ElliottとPaul HudakによるFunctional Reactive Animation (Fran)から。アニメーションを関数的にモデリングする試みで、時間によって変化する画像と、それに対するユーザからのインタラクティブな操作を関数的に表現するため、BehaviorとEventという2つの第一級な値が考えられた。これらは論文によって多少の違いはあるけど、基本的には次のように定義される。

Behaviorは単純な時間の関数で、Eventは時間と値がペアになったストリームと考えられる。例えば時刻を表す値timeは

time :: Behavior Time
time = id

で実装できるし、一秒ごとに()を発火するeverySecondは

everySecond :: Event ()
everySecond = [(t, ()) | t <- [0..]]

と書ける。もちろんこれはセマンティクス上の話で、内部ではより効率的な表現を使っている。

BehaviorやEventを第一級の値とするようなFRPは、古典的FRP (Classical FRP; CFRP) と呼ばれ、後に出てくるシグナル関数を使うFRPとは区別される。古典的とはいっても現在でもよく使われている手法だ。

ちなみに、BehaviorとEventを総称してシグナル（Signal）と呼び、複数のシグナルを組み合わせてできた値の依存グラフのことをFRPネットワークと呼ぶことがある。

時間変化するネットワーク

時間変化する値を扱えるようになると、自然な拡張としてシグナル自体も変化する値として考えることができる。話を単純化すれば、

switch :: Behavior (Behavior a) -> Behavior a

のように、シグナルのシグナルを取って、その時点で有効な（内側の）シグナルを返す関数があれば、動的なFRPネットワークを表現できる。シグナルのシグナルは高階シグナル（higher-order signal）と呼ばれ、動的なネットワークを構築することをstructural dynamismと呼んだり、dynamic (event) switchingと呼ぶこともある。

高階シグナルとスイッチングが有効な場面は多い。例えばブラウザのようにタブを作成・削除・切り替えるアプリケーションで、現在のビューを表すcurrentViewはこんな風に定義できる*1

-- ブラウザはBehavior HtmlViewをレンダリングするものとする。
currentView :: Behavior HtmlView
currentView = switch $
  Map.findWithDefault initialView
    <$> activeTabIndex
    <*> tabs

-- 現在選択されているタブのインデックス
activeTabIndex :: Behavior TabIndex
activeTabIndex = stepper 0 tabClicked

-- tabsは現在開いている全部のタブをMapで保持している。
-- キーにはTabIndexという整数値を想定している。
tabs :: Behavior (Map TabIndex (Behavior HtmlView))
tabs = accumB (Map.singleton 0 initialView) $ mconcat
  [ uncurry Map.insert <$> tabCreated
  , Map.delete <$> tabDeleted
  ]

-- スイッチング
-- 通常FRPライブラリ側で提供される。
switch :: Behavior (Behavior a) -> Behavior a

-- stepperはEventが起こるまでは初期値、Eventが発生したら
-- そのイベントの値を保持するBehaviorを作る。
-- 通常ライブラリ側で提供される。
stepper :: a -> Event a -> Behavior a

-- accumBは初期値に対して、Eventにより生成された関数を
-- 都度適用した値をBehaviorとする。
-- 通常ライブラリ側で提供される。
accumB :: a -> Event (a -> a) -> Behavior a

-- tabCrated等はユーザからの入力によって起こるイベントを
-- 表している。
tabCreated :: Event (Behavior HtmlView)
tabDeleted :: Event TabIndex
tabClicked :: Event TabIndex

-- ブラウザ表示の初期値。
initialView :: HtmlView

instance Functor Behavior
instance Applicative Behavior
instance Functor Event
instance Monoid (Event a)

小さな部品を組み合わせて大きなものを作る関数的なアプローチになっていることがわかると思う。ここにはコールバックによる状態の管理みたいな煩雑なコードは出てこない。

このように高階シグナルを使って柔軟にネットワークを変化させられることが、FRPとそれ以前のいわゆるデータフロープログラミングを分ける大きな特徴となっている。

CFRPの性能問題

CFRPはシンプルなセマンティクスが良いところだが、効率的な実装が難しいことがわかっている。FRPの実装は、しばしば静的型付き関数型言語をホスト言語とするEDSLとして実現される。難しさのポイントは、時間変化する値を空間・時間漏れなく参照等価性を失うことなく実装しなければならないということだ。

素朴に実装したCFRPでは、高階シグナルをスイッチさせるとき、スイッチ後のシグナルは現在の値を計算するため、プログラム開始時からスイッチ時点までのシグナルを保存しておき（空間漏れ; space leak）、その履歴をすべて計算して追いつく必要がある（時間漏れ; time leak）。とはいえ履歴を保持せずスイッチ後のシグナルは初期値からスタートさせると、今度は同じシグナルが使われる箇所によって同じ時間に違う値を返すことになり、参照等価性が失われる。初期のCFRPライブラリでは素朴な実装で履歴を保存していたため、実際のアプリケーションを作ると空間・時間漏れがいとも簡単に発生してしまっていた。

この問題の対処には大きく2つのアプローチが取られた。

一つはシグナル生成器（signal generator）。もう一つはシグナル関数（signal function）である。

シグナル生成器

シグナルの履歴をもっておき、スイッチ時に計算するのではなく、スイッチ直後にシグナルの計算をスタートさせようというアイデアが考えられた。このためにはシグナル（Behavior）の定義に開始時間を表すパラメータを追加する。

これは次のようにも考えられる。

これがシグナル生成器である。Eventも同様にStartTimeを追加する。シグナルの替わりにシグナル生成器を使うことで、スイッチすると新しいシグナルが生成され、その時点から計算が始まり空間・時間漏れは起こらなくなった。

しかし、問題点も指摘されている。

• スイッチするごとにシグナルが毎度新しく生成されるので、例えばタブ切り替えするとタブの内容は以前開いていた内容ではなく、新しくタブが生成されたときと同じようになる。例えばスクロール位置を復元するには細工が必要になる。
• シグナルを直接扱う場合、同一のシグナルを複数箇所で消費しても計算は一度しか行われないが、同じシグナル生成器から同じ開始時間で生成された二つのシグナルの値は共有されず、同じ計算が重複して実行されてしまう。これは手続き的な実装を伴うメモ化をすることで回避する必要がある。

Signals, Not generators! (pdf)という論文ではシグナル生成器を使わずに、シグナルを直接扱いつつ、従来のCFRPがもつスイッチ時の非効率を解決する方法を提案している。メモ化の問題は遅延評価とunsafePerformIOで、開始時間の問題はランク2多相を使って正しい開始時間を持つシグナルしか扱えないようにして解決している。この成果はGrapefruitと、（メモ化は確認してないが少なくともランク2多相の成果は）最新のreactive-bananaに取り込まれている。

シグナル関数

一方、そもそも第一級シグナルではない解決策も提案されている。Yampaをはじめとするアロー化されたFRP（Arrowised FRP; AFRP）ではシグナルは独立して存在せず、替わりにシグナル関数を第一級の値として取り入れた。シグナル関数は次のように定義される。

シグナル関数SFはシグナルからシグナルへの関数となっている。シグナル関数の良いところは、それ自体は時間によらず不変であることだ。時間変化するシグナルは言語表面からは直接使われないため、参照等価性を心配することもない。また、無駄な計算を省くという観点からも優れている。シグナル関数は単純な状態遷移関数で表せるため、通常のHaskellなどで利用できるグラフ簡約がそのまま使える。

シグナル関数をつかうFRPの欠点についてはいくつか指摘されている。これについては後で取り上げる。

また、表現力の違いについては詳しく比較した文献が見つけられてない。例えばデータ構造に直接シグナルを埋め込みたい場合、シグナル関数では直接表現できないが、それが意味のある違いになるのか、実用上違いはないのかは僕はよくわかっていない。

Push vs. pull

FRPの実装戦略は変化の伝搬の仕方という観点からpush式とpull式の2つに分類できる。push式は値の変化を都度依存するノードに伝搬する。一方のpull式では値の変化はすぐには通知されず、値が必要になった（= サンプリング）時点で初めて計算される。

これらの選択は無駄な計算の量と変化が計算される遅延に影響する。push式のFRPで非常に密なシグナルを扱えば無駄な計算が沢山起きてしまうし、疎なシグナルであれば計算の遅延がサンプリングレートによって左右されるpull式より即時に計算されるpush式の方がよい。つまり連続的に変化するBehaviorはpull式、変化が離散的に起こるEventではpush式を採用できると理想的である。Push-pull functional reactive programmingとその実装ReactiveパッケージはCFRPでこれを実装した。一方AFRPでは長らくpull式の実装しか提案されてこなかったが、最近push-pullな実装が出てきたようだ。

シグナルベクタAFRP

従来のAFRPはいくつかの問題が指摘されていた。一つはBehaviorとEventの区別がないこと。もう一つはシグナル関数の入出力がそれぞれ一つずつに制限されていることである。

多くのCFRPではBehaviorとEventはそれぞれ別の型が用いられる。Towards safe and efficient functional programmingではこれをMulti-kindedシグナルと呼んでいる。一方でYampaのようなAFRPではシグナル関数の入出力を以下のEvent型でラップする。

-- Maybeと同じ！
data Event a = NoEvent | Event a

これを使ってSF a bをSF (Event a) (Event b)にすることで、出力がない状態を表す。これをMulti-kindedに対比させてSingle-kindedシグナルと呼ぶ。

この手法の欠点は、たとえばBehaviorにだけ意味をなすシグナル関数があっても、それをEventに適用してしまうことを防げないという点。もう一つはEventとBehaviorはそれぞれの更新頻度の特性から、効果的な最適化の余地があるのに、型が一緒になっていると区別できないので最適化できないという点が挙げられる。先の論文ではそれぞれ別の型を使った実装を提案している。

もう一つ、シグナル関数が一入力一出力である点。先の論文ではこれをUnary FRPと呼んでいる。例えば、二つの独立したEventから一つのEventを生成する場合を考える。CFRPであればEvent a -> Event b -> Event cのように関数の引数として別々のシグナルを同時に扱うことができる。一方のUnary FRPではSF a bはSignal a -> Signal bと等しいため、二つのEventを入力に取ることができない。このためSF (Event a, Event b) (Event c)つまりSignal (Event a, Event b) -> Signal (Event c)のようにシグナルの値をタプルで分けて対処する。

この処置の問題は、二つの値を持つシグナルを使いたかったのか、独立な二つのシグナルを扱いたかったのかを区別できない表現力の問題と、本来独立なシグナルを一つのシグナルにまとめることによる非効率の問題の二点が挙げられる。

先の論文ではこれらの問題を解決するため、多入力多出力のFRP（N-ary FRP）を提案している。アイデアはシグナルベクタ（signal vector）という複数の独立したシグナルをまとめたものがキーになっている。GADTを種にpromoteできる似非Haskellコードで書くと*2このようになる。

-- シグナルベクタ記述子。異なる
data SVDesc where
  C :: a -> SVDesc -- ^ ContinuousのC。Behaviorと同じ。
  E :: a -> SVDesc -- ^ EventのE。
  S :: a -> SVDesc -- ^ StepのS。効率のため離散的に変化するBehaviorをStepとしている。
  Pair :: SVDesc -> SVDesc -> SVDesc -- ^ 複数のシグナルベクタ記述子を組にする。

type family SigVec :: SVDesc -> *
type instance (C a)        = Time -> a -- ^ Continuousは時間の関数。
type instance (E a)        = (Maybe a, ChangePrefix a) -- ^ 初期値と時間から更新リストへの関数。
type instance (S a)        = (a, ChangePrefix a) -- ^ 初期値と時間から更新リストへの関数。
type instance (Pair as bs) = (SigVec as, SigVec bs) -- ^ Pairの場合は再帰的にSigVecを適用。

type ChangePrefix a = Time -> ChangeList a
type ChangeList a = [(TimeDelta, a)]

これらを使ってシグナル関数SFは次のように定義される。

-- SFはシグナルベクタasからシグナルベクタbsの関数
type family SF :: SVDesc -> SVDesc -> *
type instance SF as bs = SigVec as -> SigVec bs

論文中には依存型のないHaskellでの実装例も載っているが、この実装はリリースされてはいないようだ。

LTL

初期のFRPフレームワークでは空間・時間漏れやFRPが満たすべき因果性（causality）*3を実装で工夫して回避しているものが多かったが、もっと理論的な裏付けをする試みも進んでいる。最近になってFRPとLinear-time Temporal Logic（LTL）が対応していることがわかっている。僕まだ論文を読んでないので詳しい人がいたら教えて欲しい。

• LTL types FRP
  • 初っ端からFRP is often expressed in terms of arrows with loops, which is the type class for a Freyd category (that is a premonoidal category with a carte- sian centre) equipped with a premonoidal trace.と飛ばしてるので困っている。
  • （想像するに）Linear-time Temporal Logicを依存型でエンコードして、FRPネットワーク内で不正なループを作るのを防ぐのとかに使っている（んじゃないかなと思ってる）
• Causality for free!
  • 上と同じ人。こちらもまだちゃんと読んでない。
  • CFRPでcausalityを保証する試みらしい。
• Temporal Logic with “Until”, Functional Reactive Programming with Processes, and Concrete Process Categories
  • LTL types FRPなどの先行研究ではLTLのalwaysとeventuallyという演算がそれぞれBehaviorとEventと対応していると指摘したとのこと。
  • LTLではalwaysとeventuallyよりさらに一般的なuntilという演算があるので、それをFRPと対応づけてみたという話らしい。
  • untilに対応するものはBehaviorとEventを一般化したもので、Processと名付けたらしい。

どれも面白そうなので後で読もうと思う。

• まだドラフトだけどSemantic Domain: New Draft: Simple and Efficient Higher-Order Reactive Programmingというのもあるらしい。

実装

FRPの実装もいろいろ出てきている。まずはHaskellの実装から。

• reactive-banana
  • 比較的利用者の多そうなCFRP。数ヶ月前にdynamic switchingがサポートされた。作者が色んなところで質問に答えてて親切。
• elerea
  • Signalという名前でBehaviorのみ実装したCFRP。pull式。dynamic switchingをサポート。
  • Efficient and Compositional Higher-Order Streamsが元となった論文。
• euphoria
  • Tsuru Capitalで開発されたelereaのSignalの上にEventとDiscrete（離散的なBehavior）を実装したCFRP。elereaを実用するため思い切り拡張してみた、という感じ。社内ではpushベースの新しい実装に乗り換える話が出ている。
• Yampa
  • 古くから有名なsingle-kinded unary AFRP。歴史がある分、論文や応用例が多い。
• netwire
  • 比較的新しいsingle-kinded unary AFRP。シグナルは、普通の値かinhibitsと呼ばれる何も出力がないことを示す値を返すと定義されていて、Eventはinhibitsによって定義されている。こちらも作者が色んなところで質問に答えてて親切。
• Elm
  • Haskellで書かれたElmという言語。Elmを書いてElmコンパイラでJSにコンパイルする形式。CFRPだったと思う。論文読んだのに忘れてる。

LTLの人の成果でAgdaの実装もある。

• agda-frp-ltl
  • LTL types FRPの実装。
• agda-frp-js
  • Causality for free!の実装。JSにコンパイルする処理系。なぜAFRPでなくCFRPなの？と聞かれて、Agdaにアロー記法がないからと答えてる。

他にもいろいろある。中身についてはほとんど知らないのでコメントは控える。

• OCaml
  • React
  • Pec
  • froc
• Scala
  • scala-react
  • reactive

関連技術

近年Haskell界隈でlazy I/Oを置き換えるものとして普及してきているiterateeは、大まかに言えばEventのみ扱う一階FRPと考えられる。今年の関数プログラミングの集いでのid:mkothaさんの資料にこの言及がある。社内にこんな型のコードがある。

networkToEnee
    :: (MonadIO m)
    => (Event a -> SignalGen (Event b))
    -> Enumeratee [a] [b] m result

driveIter
    :: Iteratee [e] IO a
    -> Event (Maybe e)
    -> SignalGen (Event a)

FRPとiterateeの関係を詳しく調べて比較した人はたぶんまだいないと思うので、冬休みの研究課題が欲しい方は是非挑戦して、成果を教えて欲しい。

他にも2000年代前半あたりから、Functional Hybrid Modeling（FHM）と呼ばれるFRPを一般化したものが出てきている。FHMはFRPからcausalityの制約を取り除いたものだ。つまりある値が他の未来の値に依存することができる。FHMによって作られるネットワークはcausalである必要が無く、ループは当たり前だし、もはや有向グラフでもない。(A)FRPではシグナル関数を抽象の要としていたが、FHMではよく似たシグナル関係（signal relation）という抽象が用いられる。FRPとFHMの関係はおそらく関数型プログラミングと論理型プログラミングのパターンマッチの関係と同じなのかなと思っている。確認はしてない。

代表的な実装はHydraというHaskell上での実装で、リンク先をたどっていくと論文も読める。QuasiQuotesでシグナル関係を記述し、動的なネットワークも最適化できるようにLLVMを使ってJITコンパイルもするという、結構手の込んだ実装になっているようだ。

*1:reactive-bananaに似せた疑似コード。実際にはswitchという関数は存在しなくて、少し違う型の関数を使う。

*2:論文中ではAgdaで実装されている

*3:いかなるシグナルの値も未来の値には依存せず、過去の値にのみ依存する。

HaskellでCIするなら

函数プログラミングの集いのランチで聞かれたのでHaskellのテスト環境についてまとめます。

• githubに置いているコードを面倒な設定なしにテストしたい → cabal test + travis-ciがおすすめ
• クローズドなコードなんだけど、どうしよう → jenkinsでもセットアップしましょう
• もう少し細かいメトリクスとかとりたい → test-framework + jenkins

cabal test + travis-ci

cabal testに対応したコードをGitHubに置いていて、お手軽に済ませたいならこれが一番です。特徴は、

• とにかくカンタン
  • セットアップはリポジトリのトップにlanguage: haskellとだけ書いた.travis.ymlというファイルを置いて、travis-ciからONにするだけ。
  • http://about.travis-ci.org/docs/user/languages/haskell/ に環境の詳細とサンプルがあります。
• githubにpushしたらすぐにテストしてくれる。
• 誰かがpull requestすると、そのパッチがテストを通るかチェックしてpull requestのコメントに正否の結果をpostしてくれる。

など。

コードがクローズドとか、Haskell Platformのバージョンを変えたいとか、細かいメトリクスをとりたい場合はjenkinsが良いかもしれません。

test-framework + jenkins

travis-ciよりもっとカスタマイズした使い方を望む場合は適当な場所にjenkinsを立てるのがよいかもしれません。
Haskellのテストフレームワークでデファクト感があるtest-frameworkというパッケージにはJUnitと同じ形式のXMLを吐いてくれる機能があり、それを使うとGHCが吐く警告をまとめるようなこともできるみたいです。自分では試してないですが、https://jenkins.serpentine.com/job/aeson/ こんな感じにできるようです。

まとめ

オープンなコードならtravis-ciを使いましょう。

SICPのデジタル回路のシミュレータをFRPで書いた

最近FRPなコードを書いているので、ふとid:kazu-yamamotoさんに言われたのを思い出して書いてみました。元の問題はこちらからどうぞ。今回はelereaというライブラリを使っています。

FRPとはなんぞやな方はやさしいFunctional reactive programming（概要編） - maoeのブログを読むと雰囲気はわかるかもしれません。

コードは大まかに解説すると、

• main
  • 各部品の遅延を決めて
  • SICPの例にあった入力（Signal Bool）を組み立てて回路に入力として与える
  • replicateM_ 20でsampleを実行しているところで実際に回路が動く
• Circuitモナド
  • 単なるReaderモナドでインバータなど各部品の持つ遅延を初期値として与えるために使ってる
  • ベースのSignalGenモナドはelereaが提供しているもので、ステートフルなSignalを作るために使われる
• 回路の記述
  • Signalを受け取りSignalを返す関数になってる
  • SignalGenやCircuitはモナドになってるので、普通にdo記法で回路図の通りに書ける

といった感じです。

Signalというのは、なんぞやの文でいうBehaviourのことです。この例題は回路が動的に変わったりしないのでFRP的にはあまり面白くない例ですが、SICPでは手続き的だった流れが、カンスウガタっぽく書けていると思います。

ところで、Haskell界隈のFRPの状況はやさしいFunctional reactive programming（概要編） - maoeのブログを書いたときからだいぶ変わってきていて、当時最新だったreactiveはメンテされなくなり、変わって新しいライブラリが現れました。

elerea以外で代表的なものは

• reactive-banana
• sodium
• netwire

などです。

redditなどでもたびたび話題に上がってきて盛り上がっているので、この機会に触ってみると面白いと思います。

undefinedの代わりに$notImplementedを使おう

Haskellで一からコードを書くとき、よく型だけ書いて実装はundefinedにすることがあります。これはとても便利な常套手段なんですが、規模が大きくなってきたり、undefinedな数が多くなってくると不便に思うこともあります。

undefinedとplaceholders

一通り関数とその型の概要ができてきて、小さく動かせる範囲で実装していきましょうという段階に入ると、動かしながら実装したくなるものです。

このとき未実装の部分をundefinedにしておくと、実行時には例外が上がります。残念なことにこの例外はどこから上がったものなのかエラーメッセージを見てもわかりません。

例えばこんな感じ…

Foo: Prelude.undefined

これじゃつらいので行番号を出せるようにします！というのがplaceholdersライブラリです。

使い方は簡単で、

f :: MonadFooBar m => m [a]
f = undefined

みたいにしていたところを

{-# LANGUAGE TemplateHaskell #-}
import Development.Placeholders

f :: MonadFooBar m => m [a]
f = $notImplemented

に変えるだけ。ほかにもtodo専用もあります。

g = $(todo "ご飯食べてから実装する")

undefinedとの違いは、実行時に行番号を出してくれるだけでなく、コンパイル時に警告を出してくれる*1ので、git grep undefinedしなくても実装し忘れることがないという利点があります。こんな感じ。

src/FooBar.hs:38:7: Unimplemented feature

src/FooBar.hs:39:9: TODO: ご飯食べてから実装する

仕組みも単純で、Template Haskellでもって行番号を入れているだけです。

欠点と言えば、各ファイルにTemplateHaskellの指定とimport文を書く必要があることです。前者はcabalファイルにextensionsで指定すればいいものの、後者はどうしようもありません。

プリプロセッサplaceholders

そこで全モジュールに自動的にimport Development.Placeholdersを挿入するGHCプリプロセッサを書きました。これを使うと、ソースコード中にimport文を書かなくてもよくなります。

pull requestがまだ取り込まれてないので、インストールにはGitHubにあるソースが必要です。

git clone git://github.com/maoe/placeholders.git
cd placeholders
git checkout feature/preprocessor
cabal install # もしくはcabal-dev installなどお好みで

これで~/.cabal/configに指定されているexecutableのインストール先にplaceholdersというバイナリがインストールされます。PATHが通っている事を確認しておきましょう。

あなたのプロジェクトで実際に使うには、cabalファイルにはこんな風に指定するといいでしょう。

flag devel
  default: False

library
  ...
  if flag(devel)
    extensions: TemplateHaskell
    ghc-options: -F -pgmF placeholders
    build-depends: placeholders

こうすることで、cabal buildするとGHCが前処理の段階でplaceholdersを実行し、各モジュールの適切な場所に

import Development.Placeholders

という行を追加してくれるので、あとは必要なところに

f = $notImplemented

だの

g = $(todo "やる気が出たら実装する")

など書いていくだけです。

既知の問題

現時点では、このプリプロセッサはいくつか問題があります。pull request歓迎です。

• CPPを有効にしていると、エラーメッセージの行番号がずれる
• 何も考えずに全開importするので、notImplementedとかtodoなどの識別子がコンフリクトする可能性がある。
• UnicodeSyntaxには対応してない。

書いた本人がまだそれほど使い込んでないので使い勝手がどうか分かりませんが、もしかしたら便利かもしれません。

*1:productionでは-Werrorとしておけば、コンパイルでこけてくれる

htmlcatをSnap対応させました

htmlcatをwai + warpだけでなくsnap-core + snap-serverでも動くようにしてみました。なるべく似たようなコードになるように書いてみました。とても似ています。

Snapだとこんな感じ。

{-# LANGUAGE OverloadedStrings #-}
module HtmlCat.Snap (feedStdIn, runHtmlCat) where
import Control.Concurrent (Chan, writeChan, forkIO)
import Control.Monad (void)
import Control.Monad.Trans (MonadIO(..))
import Data.Text (Text)
import System.IO (stdin)
import qualified Data.ByteString.Char8 as B8

import Data.Enumerator (Iteratee, Enumeratee, ($$), ($=))
import Snap.Core
import Snap.Http.Server (simpleHttpServe)
import Snap.Http.Server.Config
import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder)
import qualified Blaze.ByteString.Builder.Char.Utf8 as B
import qualified Data.Enumerator as E (run_)
import qualified Data.Enumerator.List as E (map, foldM)
import qualified Data.Enumerator.Text as E (enumHandle)

import HtmlCat.Html (html)
import Snap.EventSource (ServerEvent(..), eventSourceApp)

feedStdIn :: Chan ServerEvent -> IO ()
feedStdIn chan = void . forkIO $ E.run_ $
  sourceStdIn $= textsToEventSource $$ sinkChan chan

runHtmlCat :: Chan ServerEvent -> String -> Int -> IO ()
runHtmlCat chan host port =
  simpleHttpServe (setPort port $ setBind (B8.pack host)
                                $ defaultConfig :: Config Snap ())
                  (app chan)

app :: Chan ServerEvent -> Snap ()
app chan = route [ ("",       appTop)
                 , ("stream", appStream chan)
                 ]

appTop :: Snap ()
appTop = writeBuilder $ renderHtmlBuilder html

appStream :: Chan ServerEvent -> Snap ()
appStream = eventSourceApp

sourceStdIn :: MonadIO m => Enumerator Text m a
sourceStdIn = E.enumHandle stdin

textsToEventSource :: Monad m => Enumeratee Text ServerEvent m a
textsToEventSource = E.map f
  where
    f text = ServerEvent { eventName = Nothing
                         , eventId   = Nothing
                         , eventData = [B.fromText text] }

sinkChan :: MonadIO m => Chan a -> Iteratee a m ()
sinkChan chan = E.foldM go ()
  where
    go () a = liftIO $ writeChan chan a

WAIだとこんな感じ。

{-# LANGUAGE OverloadedStrings #-}
module HtmlCat.Wai (feedStdIn, runHtmlCat) where
import Control.Concurrent (Chan, writeChan, forkIO)
import Control.Monad (void)
import Control.Monad.Trans (MonadIO(..))
import Data.Text (Text)
import Prelude hiding (lines)
import System.IO (stdin)
import qualified Data.Text as T

import Data.Conduit (($$), ($=), ResourceIO, Source, Sink, SinkResult(..), Conduit, runResourceT, sinkIO)
import Data.Conduit.Binary (sourceHandle)
import Data.Conduit.Text (decode, utf8)
import Network.HTTP.Types (headerContentType, statusOK, statusNotFound)
import Network.Wai (Application, Request(..), Response(..), responseLBS)
import Network.Wai.EventSource (ServerEvent(..), eventSourceApp)
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsHost, settingsPort)
import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder)
import qualified Blaze.ByteString.Builder.Char.Utf8 as B
import qualified Data.Conduit.List as CL

import HtmlCat.Html (html)

feedStdIn :: Chan ServerEvent -> IO ()
feedStdIn chan = void . forkIO . runResourceT $
  sourceStdIn $= lines $= textsToEventSource $$ sinkChan chan

runHtmlCat :: Chan ServerEvent -> String -> Int -> IO ()
runHtmlCat chan host port =
  runSettings (defaultSettings { settingsHost = host
                               , settingsPort = port })
              (app chan)

app :: Chan ServerEvent -> Application
app chan req =
  case pathInfo req of
    []         -> appTop req
    ["stream"] -> appStream chan req
    _          -> app404 req

appTop :: Application
appTop _ = return $
  ResponseBuilder statusOK
                  [headerContentType "text/html; charset=utf-8"]
                  (renderHtmlBuilder html)

appStream :: Chan ServerEvent -> Application
appStream = eventSourceApp

app404 :: Application
app404 _ = return $ responseLBS statusNotFound [] "Not found"

sourceStdIn :: ResourceIO m => Source m Text
sourceStdIn = sourceHandle stdin $= decode utf8

lines :: Monad m => Conduit Text m [Text]
lines = CL.map T.lines

textsToEventSource :: Monad m => Conduit [Text] m ServerEvent
textsToEventSource = CL.map f
  where
    f texts = ServerEvent { eventName = Nothing
                          , eventId   = Nothing
                          , eventData = map B.fromText texts }

sinkChan :: ResourceIO m => Chan a -> Sink a m ()
sinkChan chan = sinkIO noop (const noop) push return
  where
    noop = return ()
    push _ a = do
      liftIO $ writeChan chan a
      return Processing

snap-coreがwaiと、snap-serverがwarpと対応しています。HTMLのレンダリングはSnapフレームワークにはheistというライブラリがあるのですが、どう見てもYesod陣営のhamletの方が使いやすいので、Snapでもhamletを使っています。

Server-sent eventsの対応はwai-eventsourceに相当するものがSnapにないので、Snap.EventSourceをほぼコピペして入れてあります。snap-eventsourceとしてHackageにあげておこうかと思っています。

標準入力をブラウザでtail -fできるhtmlcatをHaskellで書いた

GNU screen 使っているとはいえ開発中に諸々のログを流しておくのにウィンドウ使うのに慣れてなくて、タブ開きまくるならやっぱりブラウザを使いたいってことで、標準入力をブラウザに出してくれるツールを書きました。

標準入力をブラウザで tail -f できる htmlcat というのを書いた - NaN days - subtech

というのを動かしてみたかったのですが、Perlの環境整備がうまくいかなかったので、Haskellで書いてみました。コードは短いのでここに貼っておきます。

maoe/htmlcat · GitHub

{-# LANGUAGE ScopedTypeVariables, QuasiQuotes, OverloadedStrings, RecordWildCards, DeriveDataTypeable #-}
module Main where
import Control.Concurrent (Chan, newChan, writeChan, forkIO)
import Control.Exception (IOException, try)
import Control.Monad (void)
import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
import Data.Foldable (forM_)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import Network (PortID(..), listenOn, sClose)
import System.IO (stdin)
import System.Process (rawSystem)
import qualified Data.Text as T
import Prelude hiding (lines)

import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import Data.Conduit (($$), (=$), ($=), (=$=), ResourceIO, Source, Sink, SinkResult(..), Conduit, runResourceT, sinkIO)
import Data.Conduit.Binary (sourceHandle)
import Data.Conduit.Text (decode, utf8)
import Network.HTTP.Types (headerContentType, statusOK, statusNotFound)
import Network.Wai (Application, Request(..), Response(..), responseLBS)
import Network.Wai.EventSource (ServerEvent(..), eventSourceApp)
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsHost, settingsPort)
import System.Console.CmdArgs
import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder)
import Text.Hamlet (Html, shamlet)
import qualified Data.Conduit.List as CL

main :: IO ()
main = do
  HtmlCat {..} <- cmdArgs htmlCat
  port <- newPort _port
  let url = "http://" ++ _host ++ ":" ++ show port
  putStrLn url
  whenJust _exec $ \exec ->
    forkIO $ void $ rawSystem exec [url]
  chan <- newChan
  runSettings (defaultSettings { settingsHost = _host
                               , settingsPort = port })
              (app chan)
  where
    whenJust = forM_

newPort :: Maybe Int -> IO Int
newPort port'm = foldr tryListening
                       (error "no available port")
                       (maybeToList port'm ++ [45192..60000])
  where
    tryListening p next = do
      r <- try . listenOn $ PortNumber (fromIntegral p)
      case r of
        Left (_ :: IOException) -> next
        Right sock -> do
          sClose sock
          return p

app :: Chan ServerEvent -> Application
app chan req =
  case pathInfo req of
    []         -> appTop req
    ["stream"] -> appStream chan req
    _          -> app404 req

appTop :: Application
appTop _ = return $
  ResponseBuilder statusOK
                  [headerContentType "text/html; charset=utf-8"]
                  (renderHtmlBuilder html)

appStream :: Chan ServerEvent -> Application
appStream chan req = do
  lift . void . forkIO . runResourceT $
    sourceStdIn $$ (lines =$= textsToEventSource) =$ sinkChan chan
  eventSourceApp chan req

app404 :: Application
app404 _ = return $ responseLBS statusNotFound [] "Not found"

sourceStdIn :: ResourceIO m => Source m Text
sourceStdIn = sourceHandle stdin $= decode utf8

lines :: Monad m => Conduit Text m [Text]
lines = CL.map T.lines

textsToEventSource :: Monad m => Conduit [Text] m ServerEvent
textsToEventSource = CL.map f
  where
    f texts = ServerEvent { eventName = Nothing
                          , eventId   = Nothing
                          , eventData = map fromText texts }

sinkChan :: ResourceIO m => Chan a -> Sink a m ()
sinkChan chan = sinkIO noop (const noop) push return
  where
    noop = return ()
    push _ a = do
      liftIO $ writeChan chan a
      return Processing

data HtmlCat = HtmlCat
  { _port :: Maybe Int
  , _host :: String
  , _exec :: Maybe String
  } deriving (Show, Data, Typeable)

htmlCat :: HtmlCat
htmlCat = HtmlCat
  { _port = Nothing     &= explicit &= name "port"
  , _host = "127.0.0.1" &= explicit &= name "host"
  , _exec = Nothing     &= explicit &= name "exec"
  }

html :: Html
html = [shamlet|
!!!
<html>
  <head>
    <title>htmlcat
    <script type="text/javascript">
      window.onload = function () {
        var es = new EventSource("/stream");
        es.onmessage = function(event) {
          var data = {};
          data.html = event.data;
          if (!data.html) {
            return;
          }
      
          if (window.scrollY + document.documentElement.clientHeight >= document.documentElement.scrollHeight) {
            var scrollToBottom = true;
          }
  
          var div = document.createElement('div');
          div.innerHTML = data.html + "\n";
  
          var out = document.getElementById('out');
          while (div.firstChild) {
            out.appendChild(div.firstChild);
          }
  
          document.title = data.html.replace(/<.*?>/g, '') + ' - htmlcat';
  
          if (scrollToBottom) {
            window.scrollTo(0, document.body.scrollHeight);
          }
        };
      };
  <body>
    <pre id="out">
|]

cloneしてcabal installすればhtmlcatコマンドが使えるようになります。

• 色付け
• --execオプション

はまだ実装してません。

Haskellでもserver-sent evnetsなどのpush技術は普通に使えますというデモでした。

追記

コマンドラインオプションを追加しました。

• --execでコマンド実行。引数にURLを渡す。
• --hostでリッスンするアドレスを指定。
• --portでリッスンするポートを指定。

色づけは大変そうな気がするので、気が向いた方は実装してpullリクエスト送ってください。

追記

入力が複数行の時バグってたのを直しました。上のコードも差し替えました。