String_random.jsをHaskellへ移植した

このエントリは Haskell Advent Calendar 2016 の N 日目ではありません。¹

String_random.js をHaskellへ移植しました。こいつの元ネタは 10年以上前からあるPerlの実装 だと思うのですが、なぜかいろいろな言語へ日本人が移植をしています。

• PHP
• Java
• golang

その中でも JSへの移植 である String_random.js は300行未満のコードで \1 のような後方参照にも対応していているというとんでもない実装だったので、これをベースにHaskellへ移植して string-random というパッケージを作りました。

Haskellへ関数型じゃない言語のコードをどうやって移植するの？

Haskellでは基本的にイミュータブルなデータを使ってプログラミングすることになりますので、アプリが持つ状態は 1). 関数に引数として渡す、 2). 新しい値を関数の戻り値として受け取る、として表現することになります。状態の型を s と書くと、アプリで使う関数の型は s -> arg1 -> arg2 -> ... -> argN -> (s, ret1, ret2, ..., retN) のような雰囲気になります。しかし、 s の受け渡しを毎回書くのは非常に面倒です。 State モナドがこのやりとりをきれいに隠蔽してくれます。今回の移植で使ったのは2箇所です。

• 正規表現のパーサにて、後方参照のためのグループの連番を管理するために、 Intを状態として引き回す
• ランダム文字列生成の際、後方参照用の各グループで生成された値を保持する Mapを状態として引き回す
  • 簡単のため擬似乱数生成器の状態も一緒に引き回している

IO を前提とした処理を書くのであれば、 ReaderT に IORef を持たせてそれを関数呼び出しの度に更新していくという、もっと手続き型チックな方法もとれます。が、今回のライブラリは IO 前提にせず純粋な処理で書きたかったのでこの形をとりました。

Haskellが得意な分野はHaskellらしく

String_random.js の正規表現パーサはスタックをとても上手に使って非常に簡潔に書かれています。が、Haskellで同じ土俵で勝負をする必要はありません。Haskellには Parsec というよく知られた非常に強力なパーサライブラリが存在しますので、そちらで書き直しています。Parsecを用いると　BNF　をほぼそのまま記述することができますので、非常に強力です。ただ、今回は元のプログラムの移植が目的でしたので、正規表現の BNF をググったりせずに同じようなパースになるようにJSのコードをちまちま書き直しました(そのせいでだいぶハマってたり)。パーサは こちら です。

このライブラリを何に使うか

String Random系のライブラリは、もともとテストで使うことを想定して作られたものです。 String::Randomのドキュメント にも the passwords generated by it are insecure と書かれていたり、システムのメインのサービスで用いることを想定しているものではありません。Haskellのテストで乱数を使うものといえば、なんといっても QuickCheck でしょう。ということで、 string-random パッケージを QuickCheck で使うための quickcheck-string-random もご用意致しました。

通常の Arbitrary のインスタンスだと、型の値全体の中からランダムな値を選ぶため、例えばメールアドレスのみを文字列として生成したくてもでたらめな文字列が生成されてしまいます。 quickcheck-string-random を使うと、e-mailアドレスっぽい Text のみを生成する Arbitrary のインスタンスを簡単に定義することができます。正規表現を Email Address Regular Expression That 99.99% Works. から拝借しましょう。

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
import Data.Text (Text, findIndex)
import Test.QuickCheck (Arbitrary(arbitrary))
import Test.QuickCheck.StringRandom (matchRegexp)
import Test.Tasty (defaultMain)
import Test.Tasty.QuickCheck (testProperty)

main :: IO ()
main = defaultMain $ testProperty "e-mail has no '+' chars" prop_emailHasNoPlus

newtype EMail = EMail Text deriving (Eq, Show)

instance Arbitrary EMail where
  arbitrary = EMail <$> matchRegexp "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|\"(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\\\[\x01-\x09\x0b\x0c\x0e-\x7f])*\")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\\])"

prop_emailHasNoPlus :: EMail -> Bool
prop_emailHasNoPlus (EMail email) = case findIndex (== '+') email of
                                     Nothing -> True
                                     _       -> False

実行結果。

$ stack runghc ./qc-sample.hs
e-mail has no '+' chars: FAIL
  *** Failed! Falsifiable (after 3 tests):
  EMail "iw-//.=.`6q.=d#7+x/.%c79`%*.1ue.jhxb/%is.0fxx4c&on.!d.+m`7.*[e-mail]1z3.9.a.o-o7.h.h"
  Use --quickcheck-replay '2 TFGenR 000000026E6FA1FF000000000007A120000000000000E17D000000F761EF6100 0 7 3 0' to reproduce.

1 out of 1 tests failed (0.00s)

とても簡単ですね！！！

1. もう埋まってしまってて参加できなかったのです。 ↩