HaskellでDiscordのBotを作る
Discordはゲーミング向けのテキストチャットと音声通話を兼ねるプラットフォームであり、「テキストチャンネル」と「ボイスチャンネル」の二種を好きなだけ作ることができる。もちろん音声を全チャンネルに常時垂れ流すわけには行かないので、通話するにはボイスチャンネルに参加するという手順を踏む必要がある。しかし、例えば誰かがやっているゲームに混ざろうとしてボイスチャンネルに参加しても、チャンネル外のユーザーにはいかなる通知も発生しないため、気づかれないままのことがよくある。
そこで、ボイスチャンネルに参加したとき、テキストチャンネルにその旨を投稿するボットを用意すれば、気軽に通話の合図を送れる。全員に通話の意思を表明でき、Skypeの着信のように邪魔にもならないので、少人数のグループにとって極めて有用である。
Discordは柔軟なAPIを用意しているため、比較的容易にそのようなボットを開発できる。もちろん、Haskellを使って実装する。この記事で使用するソースコードはGitHub - fumieval/discord-vc-notificationにある。
使ってみる (2018/02/28追記)
アプリは公開してある。このURLから認証し、テキストチャンネルのトピックにdiscord-vc-notification: General
という行を追加すれば、お使いのサーバーのGeneralボイスチャンネルに誰か参加したときに通知される。
https://discordapp.com/oauth2/authorize?client_id=418329413860458496&scope=bot&permissions=53484608
APIの利用
まず、からNew Appをクリックし、アプリおよびボットの情報を登録する。フォームを適当に埋めるだけで良い。完了したらClient IDとBot tokenをメモしておく。そして、以下のURLを開き、どのサーバーに追加するか決めて認証する。なお、53484608はパーミッションをエンコードした整数で、公式のツールで計算することができる。
https://discordapp.com/oauth2/authorize?client_id=クライアントID&scope=bot&permissions=53484608
デッキ構築
Discordは、WebSocketでリアルタイムに通信するGatewayとRESTful APIの二種類を提供し、どちらもTLSを通じる。前者はwebsockets
とTLSをサポートする為のwuss
、後者はhttp-client
とhttp-client-tls
を必要とする。stackでパッケージを作成し、package.yamlに以下の依存ライブラリを指定する。
dependencies: - base >= 4.7 && < 5 - aeson - bytestring - http-client - http-client-tls - http-types - text - time - unordered-containers - websockets - wuss - rio - unliftio
Preludeのゾロ新*1には懐疑的だが、あえてMichael Snoymanがつい最近リリースしたrioをデッキに加えた。
処理の流れ
公式ドキュメント*2でも認めるほど、Gateway APIはやや複雑だ。まずはこのインチキダイアグラムで処理の流れを確認しよう。
矢印が示す順に、メッセージの送受信を行う。
Hello
まずはGatewayに接続してみよう(dvn-connect.hs)。
import Control.Monad import qualified Data.ByteString.Char8 as B import qualified Network.WebSockets as WS import qualified Wuss as WS main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json" $ \wsConn -> forever $ WS.receiveData wsConn >>= B.putStrLn
実行すると、図に示したように、まずコード10のHelloメッセージが送られてくるのが確認できる。opがコード、dが内容を表す。heartbeat_interval
は、こちらがHeartbeatメッセージを送信すべき周期をミリ秒単位で指定している。
{"t":null,"s":null,"op":10,"d":{"heartbeat_interval":41250,"_trace":["gateway-prd-main-qrq5"]}}
Heartbeat
次にHeartbeatを送信する(dvn-heartbeat.hs)。これを怠ると一定時間後に切断されてしまう。
WebSocketの接続はプログラム全体で共有したいが、そんな時にrioが役に立つ。最大の売りであるRIO
型は、ReaderT r IO
と等価なモナドなのだ。
rioはロガーも提供しており、Env
型に放り込むことでRIO内なら好きな時にログを出力できる。
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} import RIO import UnliftIO.Concurrent import Data.Aeson import Data.Aeson.Types import qualified Network.WebSockets as WS import qualified Wuss as WS data Env = Env { wsConn :: WS.Connection , logFunc :: LogFunc } instance HasLogFunc Env where logFuncL = to logFunc send :: Value -> RIO Env () send v = ask >>= \Env{..} -> liftIO $ WS.sendTextData wsConn $ encode v
JSONの解釈にはaesonのParserモナドを使う。固有アクションの一つである(.:) :: FromJSON a => Object -> Text -> Parser a
は、オブジェクトから指定された名前のフィールドを取り出す。
そして、実行すべきアクションを結果として返す。IOアクションを別のモナドのアクションから返すコンボはなかなか有用だ。
なお、forkIO
はunliftio
パッケージで定義され、import UnliftIO.Concurrent
からインポートしたものを参照している。RIOに対応しているため、自分でReaderTを剥がす必要がなく、ボンタンアメのごとくそのまま使える。rioを使った甲斐があったと言えるだろう。
sendHeartbeat :: Int -> RIO Env () sendHeartbeat period = forever $ do send $ object ["op" .= (1 :: Int), "d" .= (251 :: Int)] liftIO $ threadDelay $ 1000 * period hello :: Object -> Parser (RIO Env ()) hello obj = do op <- obj .: "op" guard $ op == (10 :: Int) dat <- obj .: "d" interval <- dat .: "heartbeat_interval" return $ void $ forkIO $ sendHeartbeat interval
mainは以下のようになる。
main :: IO () main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json" $ \wsConn -> do logOpts <- mkLogOptions stderr True -- verbose withStickyLogger logOpts $ \logFunc -> forever $ do bs <- WS.receiveData wsConn obj <- case decode bs of Nothing -> fail "Failed to parse a JSON object" Just a -> pure a runRIO Env{..} $ case parse hello obj of Success m -> m Error _ -> logWarn $ "Unhandled: " <> displayBytesUtf8 (toStrictBytes bs)
実行するといい感じにフォーマットされたログが出てくる。なお"op":11
は、 Heartbeatに対する肯定応答だ。
Identify
次は認証のためのデータを送信する(
dvn-identify.hs)
。ここでトークンが必要になるので、環境変数から取得してEnv
にセットする。
+import System.Environment data Env = Env { wsConn :: WS.Connection + , botToken :: Text , logFunc :: LogFunc
main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
$ \wsConn -> do
+ botToken <- fromString <$> getEnv "DISCORD_BOT_TOKEN"
logOpts <- mkLogOptions stderr True
あとは固定されたデータを送るだけでかまわない。
identify :: RIO Env () identify = do Env{..} <- ask send $ object [ "op" .= (2 :: Int) , "d" .= object [ "token" .= botToken , "properties" .= object [ "$os" .= T.pack "linux" , "$browser" .= T.pack "discord-vc-notification" , "$device" .= T.pack "discord-vc-notification" ] , "compress" .= False , "large_threshold" .= (250 :: Int) , "shard" .= [0 :: Int, 1] , "presence" .= object [ "game" .= Null , "status" .= T.pack "online" , "since" .= Null , "afk" .= False ] ] ]
hello
を受け取った直後に送信するようにすれば完成だ。
interval <- dat .: "heartbeat_interval" - return $ void $ forkIO $ sendHeartbeat interval + return $ do + _ <- forkIO $ sendHeartbeat interval + identify
実行すると以下のような出力が得られるはずだ。READY
は認証に成功したことを意味し、このボットを承認しているサーバーの数だけGUILD_CREATE
が送られてくる。
2018-02-11 16:22:46.592659: [warn] Unhandled: {"t":null,"s":null,"op":11,"d":null} @(tutorial/dvn-identify.hs:75:20) 2018-02-11 16:22:46.593743: [warn] Unhandled: {"t":"READY","s":1,"op":0,"d":{"v":6,"user_settings":{},"user":{"verified":true,"username":"Wight","mfa_enabled":false,"id":"410395043501965312","email":null,"discriminator":"4943","bot":true,"avatar":"d4b67c58bf382981f5fb8ce73930cf4c"},"shard":[0,1],"session_id":"82c05e747cd8480db30909572a9a493e","relationships":[],"private_channels":[],"presences":[],"guilds":[{"unavailable":true,"id":"349143256711561216"},{"unavailable":true,"id":"410796870978502657"}],"_trace":["gateway-prd-main-1476","discord-sessions-prd-1-19"]}} @(tutorial/dvn-identify.hs:75:20) 2018-02-11 16:22:46.594370: [warn] Unhandled: {"t":"GUILD_CREATE", ...
Guild Create
いよいよ本質的な機能の実装に迫る。どのボイスチャンネルを監視し、どのテキストチャンネルに投稿するのかを、チャンネルに設定されたトピックを読み込んで決める(dvn-watchlist.hs)。
現在は受信処理をするのはhello
しかないが、Object -> Parser (RIO Env ())
を合成可能にすれば新しいハンドラを定義できる。答えは簡単で、Altモノイドを使えばよい。Alt
はAlternativeのインスタンスをMonoid
に変換するラッパーで、Parser
が失敗した時に次のハンドラを呼び出すことができる。これからよく使うので、型シノニムを定義しておこう。
+import Data.Monoid
-hello :: Object -> Parser (RIO Env ()) -hello obj = do +type MessageHandler = Object -> Alt Parser (RIO Env ()) + +combined :: MessageHandler +combined = mconcat [hello] + +hello :: MessageHandler +hello obj = Alt $ do
- runRIO Env{..} $ case parse hello obj of + runRIO Env{..} $ case parse (getAlt . combined) obj of
サーバー内のチャンネル一覧を含む巨大なオブジェクト(guildオブジェクト)がGUILD CREATE
メッセージとして飛んでくる。これを処理する関数guildCreate
と、チャンネルのトピックを読み込み、監視すべきボイスチャンネルの一覧を取得するwatchList
を定義する。取得した情報はHashMapのIORefとして管理する。
+import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T
, logFunc :: LogFunc
+ , watchMap :: IORef (HM.HashMap Text Text)
}
logOpts <- mkLogOptions stderr True
+ watchMap <- newIORef HM.empty
withStickyLogger logOpts $ \logFunc -> forever $ do
watchList
はdiscord-vc-notification:
で始まる行をトピックから探し、IDの一覧を取り出す。ボイスチャンネルについてはそもそもtopic
フィールドが存在しないので、空のリストを返す。
watchList :: Object -> Parser [(Text, Text)] watchList obj = do topic <- obj .: "topic" tcid <- obj .: "id" return $ do str <- T.lines topic vcids <- maybeToList $ T.stripPrefix "discord-vc-notification:" str vcid <- T.splitOn " " vcids guard $ not $ T.null vcid return (vcid, tcid) <|> pure []
各チャンネルについてwatchList
を呼び出し、HashMapに変換したのちIORefに書き込む。
guildCreate :: MessageHandler guildCreate obj = Alt $ do t <- obj .: "t" guard $ t == ("GUILD_CREATE" :: Text) dat <- obj .: "d" chs <- dat .: "channels" wm <- HM.fromList . concat <$> traverse watchList (chs :: [Object]) return $ do Env{..} <- ask writeIORef watchMap wm logDebug $ "watchlist: " <> displayShow wm
忘れずに定義した関数をcombined
に追加しよう。
combined :: MessageHandler
combined = mconcat
[ hello
+ , guildCreate
]
Discordのチャンネルのトピックに、discord-vc-notification: 41xxxxxxxxxxxxxx(チャンネルID)
という行を追加してみよう。チャンネルIDはDiscordのクライアントからUser Settings -> Appearance -> Developer Modeを有効にし、チャンネル名を右クリックすることで取得できる。成功すれば、起動時に以下のようなログが出るはずだ。
2018-02-11 17:06:35.557899: [debug] watchlist: fromList [("349143256711561218","410323579796717579")] @(tutorial/dvn-watchlist.hs:79:5)
Voice State Update
ユーザーが参加、退出、ミュートなどの操作をしたとき、VOICE_STATE_UPDATE
メッセージが送られてくる。内容はVoice Stateオブジェクトで、ここからユーザーIDとチャンネルIDを取り出す。
ユーザーが参加した時だけその旨を投稿したいので、退出やミュートに関するイベントは無視する必要がある。そのため、各ユーザーはどのボイスチャンネルに入っているかをHashMapで管理する。
, watchMap :: IORef (HM.HashMap Text Text)
+ , memberState :: IORef (HM.HashMap Text Text)
}
watchMap <- newIORef HM.empty
+ memberState <- newIORef HM.empty
withStickyLogger logOpts $ \logFunc -> forever $ do
この場合アトミック性は要求されないが、atomicModifyIORef
の結果としてアクションを返す小技を紹介しておこう。
voiceChannelJoin :: MessageHandler voiceChannelJoin obj = Alt $ do t <- obj .: "t" guard $ t == ("VOICE_STATE_UPDATE" :: Text) dat <- obj .: "d" cid <- dat .:? "channel_id" uid <- dat .: "user_id" return $ do Env{..} <- ask wm <- readIORef watchMap joined <- atomicModifyIORef memberState $ \ms -> (HM.alter (const cid) uid ms, do vc <- cid tc <- HM.lookup vc wm return $ postJoined uid vc tc) sequence_ joined postJoined :: Text -> Text -> Text -> RIO Env () postJoined uid vc tc = logInfo $ mconcat [display tc, ": ", display uid, " joined ", display vc]
combined :: MessageHandler combined = mconcat [ hello , guildCreate + , voiceChannelJoin ]
combinedに新しいハンドラを追加して出来上がり( dvn-update.hs )。実際にDiscord側のボイスチャンネルに参加してみると、以下のようなログが残る。体裁を整えてメッセージとして投稿すればいよいよ完成だ。
2018-02-11 17:23:44.765171: [info] 410796870978502659: 345439212583256064 joined 410796870978502661
POST /channels/:channel_id/messages
dvn-post.hs からはいよいよRESTful APIの出番が出てくる。異なるプロトコルなのでやや面倒ではあるが、特別難しいことはない。
+import qualified Data.Text.Encoding as T +import Data.Time +import qualified Network.HTTP.Client as HC +import Network.HTTP.Client.TLS +import Network.HTTP.Types
HTTPクライアントのマネージャーを用意しておく。プログラム全体で扱う値をEnv
型にまとめておいたおかげで、このような変更がしやすい。
{ wsConn :: WS.Connection
+ , hcManager :: HC.Manager
, botToken :: Text
memberState <- newIORef HM.empty
+ hcManager <- HC.newManager tlsManagerSettings
withStickyLogger logOpts $ \logFunc -> forever $ do
APIを呼び出す関数は以下のように定義できる。
discordApi :: Method -> [Text] -> Maybe Value -> RIO Env Object discordApi m ps obj = ask >>= \Env{..} -> do initialRequest <- liftIO $ HC.parseRequest "https://discordapp.com/" resp <- liftIO $ HC.httpLbs initialRequest { HC.method = m , HC.path = T.encodeUtf8 $ T.intercalate "/" $ "/api" : ps , HC.requestBody = maybe mempty (HC.RequestBodyLBS . encode) obj , HC.requestHeaders = [ ("Authorization", "Bot " <> T.encodeUtf8 botToken) , ("User-Agent", "discord-vc-notification") , ("Content-Type", "application/json") ] } hcManager case decode $ HC.responseBody resp of Nothing -> fail $ "Malformed response: " ++ show (HC.responseBody resp) Just a -> return a
ボイスチャンネルに参加した時、以下の内容を投稿したい。
- 時刻
- チャンネル名
- ユーザー名
- できればアイコンも
それを実現してくれるのが埋め込みオブジェクトだ。それぞれ、timestamp
、description
、ユーザー名とアイコンはauthor
に含めることでいい感じに投稿できる。GET /users/:user_id
を呼び出すとユーザーの名前とアイコンのURLのための識別番号を取得できる。実際に投稿できるようにpostJoined
を書き換える。
postJoined :: Text -- user id -> Text -- voice channel id -> Text -- text channel id -> RIO Env () postJoined uid vc tc = do now <- liftIO getCurrentTime uInfo <- discordApi "GET" ["users", uid] Nothing author <- either fail pure $ flip parseEither uInfo $ const $ do name <- uInfo .: "username" avatar <- uInfo .: "avatar" return $ object [ "name" .= (name :: Text) , "icon_url" .= T.intercalate "/" ["https://cdn.discordapp.com", "avatars", uid, avatar <> ".png?size=256"] ] void $ discordApi "POST" ["channels", tc, "messages"] $ Just $ object [ "content" .= T.empty , "embed" .= object [ "description" .= T.concat ["Joined <#", vc, ">"] , "timestamp" .= formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now , "author" .= author ] ]
そして、ボイスチャンネルに参加すると、このようなメッセージが投稿される。あたかもテキストチャンネルに参加したかのように表示されている(おそらくDiscordクライアントのバグ)が、なかなかこぎれいにまとまっている。
無関係なメッセージを無視する処理などを加えて仕上げたのがMain.hsだ。
まとめ
特に非自明なことをやったつもりはなかったが、いくつかの発見があった。
- monad-controlのより安全*3な代替物としてのunliftioの存在。
- IOアクションを別のモナドのアクションとして返す技「モナド重ね」の有用性。
- 欲しいものを自分で実現できるDiscordのAPIの網羅性。
DiscordのBot開発は、下手なゲームよりも遊び甲斐がありそうだ。
ガバガバAltJSを作った(言語実装 Advent Calendar 2017)
JavaScriptを書いていると、頻出する継続渡しのリフレインにうんざりさせられる。
foo.bar(function(result){ qux.baz(function(data){ hoge(function(r){ ... }); }); });
そこで、腕試しに継続モナドをベースにしたAltJS、jatkoを作った。フィンランド語で「継続」という意味だ(継続戦争から知った人も多いだろう)。しかし、なんの考えもなしに653行Haskellを書いた結果ガバガバな言語になってしまった。
Hello, world
Haskellにだいぶ近いのでなんとなく読めるはず。
infixr 1 -> infixr 0 $ ($) = \x -> x constructor String : Type constructor (->) : Type -> Type -> Type constructor JSAction : Type -> Type constructor JSCont : forall b r. ((b -> r) -> r) -> JSAction b register return JSAction = \a -> JSCont $ \cont -> cont a register bind JSAction = \m k -> JSCont $ \cont -> case m of JSCont f -> f $ \a -> case k a of JSCont c -> c cont console'log = [|function(str){ return function(cont){console.log(str); cont(null);}|] : String -> JSAction Unit main = (do console'log "hello,"; console'log "world") JSAction
console'log = [|function(str){ return function(cont){console.log(str); cont(null);}|] : String -> JSAction Unit
この部分が重要で、継続渡しスタイルな生JSをBSDブラケットで囲むことでアクションを定義でき、do記法でフラットに組み合わせることができる。
ガバガバポイントその1: 型と値を区別しない
型も値も同じ構造で扱うという、JavaScriptもびっくりなガバガバ仕様を採用した。すべてはこのExpr
型の値として表される。
data Literal = LInt !Int | LDbl !Double | LStr !String | LJavaScript !String deriving (Show, Eq) data Expr a = Var a -- ^ 変数 | Expr a :$ Expr a -- ^ 適用 | Con !Name [Expr a] -- ^ コンストラクタ | Lit !Literal | Lam !Name (Expr a)-- ^ ラムダ | Case [(Name, [Name], Expr a)] -- ^ パターンマッチ | Expr a ::: Expr a -- ^ 型シグネチャ | Forall !Name (Expr a) -- ^ 全称量化 | Coerce (Expr a) deriving (Show, Eq, Functor, Foldable, Traversable)
ガバガバポイントその2: 後付けできるパターンマッチ
register return JSAction = \a -> JSCont $ \cont -> cont a
とすると、return
が種Type -> Type
の型tを受け取り、a -> t a
を返す関数として定義され、JSActionに対する実装が追加される。実装を後から増やすことが可能で、型クラス相当の役割を担うが、クラスに相当する宣言が今の所存在しない。
ガバガバポイントその3: 怪しい型推論
型推論器は何も参考にせず勝手気ままに実装した。それっぽく振舞うが、高い確率で欠陥がある。
気づきなど
構文解析にはparsers、実装としてtrifectaを使った。これがなかなか使いやすく、二項演算子からリテラルまでだいたい欲しいものが揃っている。特に面白いのは、「改行をスキップしない」のようなパーサーの変化をモナド変換子によって実現しているところだ。これは「モナド変換子の代替」とされるExtensible effectsでは素直にはいかないだろう。
オフサイドルールの実装はなかったので、同じようにモナド変換子として実装を試みたが、do記法がうまく扱えなかった。しっくりくる実装ができたらプルリクエストを送りたい。
演算子の優先順位などの情報を共有したり、型推論器で状態を扱うのにもReaderT、StateTなどが役に立つ。まとめると、パーサーコンビネータとモナド変換子があれば言語処理系が作れるというわけだ。
HaskellのABC(Haskell Advent Calendar 6th)
Haskellといえば一文字変数名、一文字変数名といえばHaskellという{{要出典}}ほどにHaskellでは一文字の変数名がよく使われている。これは名前を考えるのをサボっているとは限らない。多相性によって変数が具体的な性質を持たないがゆえに、具体的な名前がつけられないというのが主な理由だ。あるいは、適切な名前があっても、既存の名前と被っているという場合もある。かといって完全なランダムというわけでもないので、一文字変数名はどのように選べばいいか考察していこう。
a
よくある種: *
アルファベットの最初であるaは汎用性が高い。型変数に使うのが王道だ。値レベルの変数として単体で使うことは意外と少ない。
reverse :: [a] -> [a]
b
よくある種: *
aに続いて、bも型変数によく使われる。
map :: (a -> b) -> [a] -> [b]
c
三つの値が与えられたとき、それぞれa, b, cとつけることが多い。また、継続(continuation)に名前を付けたいがk
とcont
が使用済みな場合にも使う。
d
よくある型 Float, Double
差分(difference)もしくは行列式(determinant)として。dx,dyのように他のアルファベットと組み合わせる場合も多い。
e
何かの要素(element)であるという性質を強調したいとき、型、値ともに使うことがある。
f
よくある種 * -> *
関数(function)を表すのに非常に重要だ。Alternative以下な関手のための型変数にもよく使われる。
g
よくある種 * -> *
fとほぼ同じ用途である。
h
fと同じ使い方もするが、高さ(height)としての出番が多い。
area :: Num a => Rectangle a -> a area (Rectangle w h _ _) = w * h
i
よくある型 Int
添字(index)を表す定番の文字で、言語を問わずよく使われている。入力(input)を表すのにも使う。
j
よくある型 Int
iに続いて添字を表す。筆者はヤコビアンに使ったこともあるが、あまりいい例とは言えない。
forM_ [0..9] $ \i -> forM_ [0..9] $ \j -> putStrLn $ show i ++ " * " ++ show j ++ " = " ++ show (i * j :: Int)
k
第三の添字あるいはマップのキーのほか、Haskellにおいては継続の名前としてもよく使われる。種変数も忘れてはいけない。
answer :: ContT r IO Int answer :: ContT $ \k -> do putStr "Calculating the answer..." k 42 putStrLn "Done."
l
長さ(length)として。まれに、内容に興味のないリストの名前として使うこともある。
m
よくある種 * -> *
よくある型 Map k v, Int
モナドの型変数や、モナディックなアクションの名前として頻繁に使う、ある意味Haskellらしい変数名だ。nと共に、整数の変数としてもしばしば出番が来る他、マップの名前としても使う。
when :: Monad m => Bool -> m () -> m ()
n
よくある型 Int
自然数ないし整数を表すことが多い。モナドが二つあるときに使うことも稀にある(mmorphなど)
o
oは忌避される傾向があるが、原点、オプション、出力など、いくらか使い道はある。
p
よくある型 Double, a -> Bool
パラメータ、位置(position)、点(point)、述語(predicate)、ピボットなどに引っ張りだこだ。
q
pに続いてパラメータとして使われる。クエリにも。
r
よくある型 a -> r
結果または継続を表す。これを奪われると個人的にきつい。
newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
s
よくある種 *
状態(state)、ストリーム、構造(structure)などに使う。個人的なお気に入りだ。
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
t
よくある型 Float, Double
時間(time)、接点、接線(tangent)など。
u
よくある型 Float, Double
UV座標系を扱う際、vとの対で用いる。
v
よくある型 Float, Double
「値(value)」として漠然と使うこともあれば、ベクトル(vector)を表すこともある。言語処理系を実装する際は変数(variable)という意味でも用いる。
w
よくある型 Float, Double
幅(width)、重み(weight)、あるいはクオータニオンの成分など。モナドの双対であるコモナドの型変数としても使われる。その心は上下反転させたm。
x
よくある種 *
値の変数の定番中の定番だ。振る舞いに一切関与しない型変数にも用いられる。
y
xと同様、変数に使う。
z
x,yと同様、汎用的な変数名。座標を扱う際は頻繁に用いる。rが使えないときに代用することもできる。
総評
抽象度の高いコードにおいて、名前をつけるというのはなかなか難しい問題の一つだ。幸い、型変数含め局所的な変数なら一文字でも行儀は悪くないので、既存のライブラリなども参考にしつつガンガン短い名前を使っていこう。
ステートマシン猛レース
ストリーム処理ライブラリはHaskellにおいて競争の激しい分野の一つだ。ストリーム処理ライブラリとは大雑把に言うと、IOなどの作用を絡めながら値の列(ストリーム)を生成したり、処理したりする構造を提供するライブラリである。多くのライブラリは、以下の3種の構造を定義している。
- 生産者(プロデューサー): IOなどのアクションを伴いつつ値を生成する。
- 消費者(コンシューマー): 多くの場合モナド変換子になっており、
await :: Consumer s m s
のようなアクションを組み合わせ、値の列を処理するプログラムを書ける。 - 変換者(トランスデューサー): 入力を受け取りながら、出力もできる。
生産者と消費者が変換者の特殊な場合であるものも多い。
今回は、基本中の基本とも言える操作であるスキャンの速さを調べる。scan (+) 0
は入力ストリーム[0,1,2,3, ...]
を出力[0,1,3,6, ...]
のように変換する。
iteratee, tubes, streaming, machinecell, io-streams, pipes, machines, conduit, boomboxと試作品のfeeders、predatorsパッケージをベンチマークした。ソースコードはhttps://github.com/fumieval/feeders/blob/all-bench/benchmarks/benchmark.hsにある。 ライブラリ数という点では、2017年現在最も網羅的なベンチマークだろう。
pipes
- 使用実績: ghc-mod, purescript
- 利点 速い、ドキュメントが豊富
- 欠点 終端、残余を扱えない
まずは人気のpipes。yieldとawaitをモナドで組み合わせる素直なインターフェイスが魅力で、scanの実装もわかりやすい。
ただし、runEffect
以外の方法での分解はあまり想定していないのか、自分でPipe
を分解するにはPipes.Internal
モジュールをインポートしないといけない。その際はpipesの設計の理解が必須となる。
scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r scan step begin done = go begin where go x = do yield (done x) a <- await let x' = step x a go $! x'
変換に相当する値と、それを走らせる関数に分けてCriterionでベンチマークする。
sourceP :: Monad m => P.Producer Int m () sourceP = each [1..10000] drainP :: Pipe Int a Identity () -> () drainP p = runIdentity $ runEffect $ for (sourceP >-> p) discard main = defaultMain [ bench "pipes" $ whnf drainP (scan (+) 0 id) ]
10000要素を処理するのに179μsという結果が出た。一件あたり18ナノ秒はなかなか悪くないと言えるだろう。なおGHCは8.0.2で、CPUはIntel(R) Core(TM) i7-6700K CPU @ 4.00GHzである。
time 179.3 μs (177.9 μs .. 180.8 μs) 1.000 R² (0.999 R² .. 1.000 R²) mean 179.1 μs (178.4 μs .. 179.9 μs) std dev 2.457 μs (2.043 μs .. 3.124 μs)
tubes
- 利点 インターフェイスが親しみやすい
- 欠点 極端に遅い
time 22.99 s (22.21 s .. 24.75 s) 0.999 R² (0.999 R² .. 1.000 R²) mean 22.86 s (22.61 s .. 23.04 s) std dev 269.8 ms (0.0 s .. 308.6 ms)
23「秒」という圧倒的な時間が目を引いたのはtubesだ。Freeモナドをベースにした基本を押さえたAPI、リストモナド相当のSource
に加えContravariantなSink
と第一印象は良いが、さすがに10万倍も遅いと実用的とは言いがたい。
scanT :: Monad m => (b -> a -> b) -> b -> Tube a b m x scanT f = go where go b = await >>= \x -> let !b' = f b x in yield b' >> go b' sourceT :: Monad m => Tube () Int m () sourceT = each [1..value] drainT :: Tube Int a Identity () -> () drainT h = runIdentity $ runTube $ sourceT >< h >< stop
streaming
使用実績: 不明
- 利点 速い
- 欠点 消費者がない
benchmarking scan/streaming time 77.40 μs (77.07 μs .. 77.74 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 77.17 μs (77.01 μs .. 77.41 μs) std dev 668.9 ns (552.8 ns .. 820.2 ns)
streamingはpipesの倍以上の速度が印象的だ。streamingには変換者や消費者に相当する構造はないため、やや不公平な比較かもしれない。
Stream (Of a)
がaを生産するモナド変換子であり、これをリストのように扱う数々の関数が提供されている。
drainS :: (Stream (Of Int) Identity () -> Stream (Of a) Identity ()) -> () drainS h = runIdentity $ effects $ h sourceS sourceS :: Monad m => Stream (Of Int) m () sourceS = each [1..value] ... , bench "streaming" $ whnf drainS (S.scan (+) 0 id)
ストリーム処理ライブラリを使う動機はモナディックな消費であることが多いが、そうでない場合は選択肢となりうるだろう。
io-streams
使用実績: snap
- 利点 速い
- 欠点 何を書くにもIOを使わないといけない
time 87.93 μs (86.58 μs .. 89.68 μs) 0.996 R² (0.989 R² .. 1.000 R²) mean 88.13 μs (87.08 μs .. 91.47 μs) std dev 5.351 μs (1.913 μs .. 10.55 μs) variance introduced by outliers: 63% (severely inflated)
io-streamsは使うモナドをIOに限定するという開き直った設計のパッケージだ。たかをくくっていたが、streamingに迫る速度が出ており侮れない。
import qualified System.IO.Streams as Is drainIs :: (Is.InputStream Int -> IO (Is.InputStream b)) -> IO () drainIs h = do i <- Is.fromList [1..value] i' <- h i o <- Is.nullOutput Is.connect i' o scanIs :: (b -> a -> b) -> b -> Is.InputStream a -> IO (Is.InputStream b) scanIs f b0 i = do r <- newIORef b0 Is.makeInputStream $ Is.read i >>= \case Nothing -> return Nothing Just x -> do b <- readIORef r let !b' = f b x writeIORef r b' return $ Just b'
machines
使用実績: 不明
- 利点 各種構造が透明で、拡張性に富む
- 欠点 Tee、Stackなどの発展形はAPIが乏しく、うまく合成できない
ekmett発のmachinesはまずまずの性能だ。
time 190.8 μs (190.1 μs .. 191.5 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 190.7 μs (190.2 μs .. 191.1 μs) std dev 1.542 μs (1.366 μs .. 1.771 μs)
PlanT
というCPSのモナドから変換器のMachineT
を鋳造するというアプローチを用いている。複数の入力をサポートしているのも面白い。比較的習得は容易だが奥が深い。また、pipesと違い終端に対応できる。
sourceM = enumerateFromTo 1 value drainM :: ProcessT Identity Int o -> () drainM m = runIdentity $ runT_ (sourceM ~> m) , bench "machines" $ whnf drainM (scan (+) 0)
conduit
使用実績: Yesod
- 利点 ストリームの終端や残りをきちんと扱える
- 欠点 APIが複雑。オーバーヘッドがある
time 302.4 μs (301.5 μs .. 303.3 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 302.1 μs (301.6 μs .. 302.8 μs) std dev 2.029 μs (1.547 μs .. 2.515 μs)
かつて黄金時代を築いたconduitはmachinesよりも遅かった。しかし、ストリームの終端及び残余、リソースの解放などをサポートしていることを考えればかなり優秀だと言える。
import qualified Data.Conduit.List as C import qualified Data.Conduit.Combinators as CC drainC :: C.Conduit Int Identity a -> () drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull sourceC = C.enumFromTo 1 value , bench "conduit" $ whnf drainC (CC.scanl (+) 0)
この手のライブラリに依存しないような環境の変化が起こったものの、まだまだ現役だ。コンビネータの種類が非常に多く、ハードルが高いという難点もある。
iteratee
- 利点 ストリームの終端、残余はもちろんシークなども表現可能
- 欠点 遅い。設計が汚く、扱いが非常に難しい
使用実績: Tsuru Capital
最古参のiterateeはpipesの約20倍遅いという残念な結果となった。
time 3.392 ms (3.299 ms .. 3.502 ms) 0.995 R² (0.993 R² .. 0.998 R²) mean 3.361 ms (3.325 ms .. 3.399 ms) std dev 121.1 us (105.5 us .. 142.4 us) variance introduced by outliers: 20% (moderately inflated)
実装もわかりやすいとは言いがたい。今あえてこのライブラリを選択する必要はないだろう。iterateeを使ったコードを保守するのは苦行そのものだ。
import qualified Data.Iteratee.Iteratee as I import qualified Data.Iteratee.ListLike as I scanI :: Monad m => (b -> a -> b) -> b -> I.Enumeratee [a] [b] m x scanI f = I.unfoldConvStream (\a0 -> I.liftI $ \case I.Chunk xs -> return $ mapAccumL (\a x -> let !r = f a x in (r, r)) a0 xs I.EOF _ -> return (a0, [a0])) sourceI :: I.Enumerator [Int] Identity a sourceI = I.enumList $ map pure [1..value] drainI :: I.Enumeratee [Int] [a] Identity () -> () drainI h = runIdentity $ I.run $ runIdentity $ I.run $ runIdentity $ sourceI $ h $ I.mapM_ $ const $ return ()
feeders
- 利点 iterateeの問題点を克服し、親しみやすいインターフェイスを持つ
- 欠点 まだまだ遅い
time 414.3 μs (409.7 μs .. 421.8 μs) 0.998 R² (0.996 R² .. 1.000 R²) mean 413.9 μs (412.1 μs .. 421.0 μs) std dev 9.814 μs (3.347 μs .. 22.63 μs) variance introduced by outliers: 15% (moderately inflated)
Feederは、「消費者に供給する構造」として生産者を表現するiterateeの考え方を継承しつつ、よりまともなデザインを目指した試作品だ。
Eaterモナドが消費者、FeederがEaterを変換するモナドとして実装されている。
newtype Feeder s n m a = Feeder { unFeeder :: forall x r. Eater s n x -> (a -> Eater s n x -> m r) -> m r } killEater :: Monad m => Eater s m a -> m a sinkNull :: Monad m => Eater s m () feed :: Monad m => Feeder s n m a -> Eater s n x -> m (a, Eater s n x) type Rancher a b m = Feeder b m (Eater a m) (>-$) :: Monad m => Rancher a b m x -> Eater b m r -> Eater a m r scan :: Monad m => (b -> a -> b) -> b -> Rancher a b m () scan f b = lift await >>= \case Nothing -> return () Just a -> do let !b' = f b a yieldOn liftP b' scan f b' drainF :: Rancher Int a Identity () -> () drainF h = runIdentity $ killEater $ snd $ runIdentity $ feed sourceF $ h >-$ sinkNull sourceF :: Feeder Int Identity Identity () sourceF = yieldMany [1..value]
こちらもストリームの終端と残余を扱えるが、conduitにスピードに負けていては仕方がない。
predators
- 利点 iterateeやconduitと同等の実用的な表現力を、一風変わったシンプルな実装で実現
- 欠点 生産者を使いきって消費者を残すインクリメンタルな使い方はできない
PredatorはFeederとは逆に、生産者を捕食する構造として消費者を実装した。
prey :: Monad m => Predator s n m a -> Prey s n x -> m (Maybe (a, Prey s n x)) type Heterotroph a b m = Predator a m (Prey b m) (@->) :: Monad m => Prey a m x -> Heterotroph a b m r -> Prey b m (Maybe r) scan :: Monad m => (b -> a -> b) -> b -> Heterotroph a b m () scan f b = do a <- awaitOn lift let !b' = f b a lift $ yield b' scan f b' drainPd :: Heterotroph Int a Identity () -> () drainPd h = maybe () fst $ runIdentity $ prey Pd.sinkNull $ sourcePd @-> h sourcePd :: Prey Int Identity () sourcePd = yieldMany [1..value]
conduitと全く異なるアプローチでありながら、残余と終端を処理でき、同等の速度も出ているのでポテンシャルを秘めている。私のやる気が続けばさらなる進展があるかもしれない。ネーミングも気に入っている。
time 300.7 μs (299.2 μs .. 302.1 μs) 0.999 R² (0.998 R² .. 0.999 R²) mean 314.9 μs (310.0 μs .. 321.2 μs) std dev 19.03 μs (13.81 μs .. 23.15 μs) variance introduced by outliers: 56% (severely inflated)
boombox
- 利点 高い柔軟性と高パフォーマンスを両立している
- 欠点 APIが非常に乏しい
ストリーム処理の大統一を目指して作ったライブラリboomboxはpipesよりも速い。
time 160.7 μs (160.1 μs .. 161.5 μs) 1.000 R² (0.999 R² .. 1.000 R²) mean 163.1 μs (162.1 μs .. 164.1 μs) std dev 3.382 μs (2.810 μs .. 4.125 μs) variance introduced by outliers: 14% (moderately inflated)
生産と消費にTapeとPlayerTという専用の構造を用意し、変換器は両者を組み合わせて表現する。ストリームの残余処理、シークなどなんでも表現できるが、可能性を残しすぎたことが仇となりAPIが乏しい。Recorder Identity Identity
がPipe
に相当する変換器で、Identity
をStore
に差し替えればシーク可能になり、当然通常のストリームからシーク可能なストリームへの変換器も定義できる。NonEmpty
コモナドを使えば複数の世界線に分岐するようなストリームも表現できる。machinesと違い、どうカスタマイズしても必ず合成ができるのがポイントだ。
scanB :: (b -> a -> b) -> b -> Recorder Identity Identity m a b scanB f = go where go b = Tape $ await >>= \x -> let !b' = f b x in return (b', pure $ go b') sourceB :: Tape Identity Maybe Int sourceB = tap [1..value] drainB :: Recorder Identity Identity Maybe Int a -> () drainB h = maybe () (\(_,_,r) -> r) $ sourceB @.$ h >-$ forever await
パフォーマンスは良好なので、全ライブラリの統一を目指して研究を続けていきたい。
machinecell
- 利点 今のところ唯一のArrowベースのライブラリ
- 欠点 遅い
time 185.5 ms (184.1 ms .. 188.5 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 184.2 ms (183.4 ms .. 185.3 ms) std dev 1.176 ms (562.9 μs .. 1.702 ms) variance introduced by outliers: 14% (moderately inflated)
machinecellはアロー変換子としてストリーム変換器を実装した異色のパッケージだ。これもなかなか速い、と思いきや単位がマイクロではなくミリで、pipesの1000分の1の速さだった。今後の改良に期待したい。
drainMc :: Mc.ProcessA (->) (Mc.Event Int) a -> () drainMc h = Mc.run_ (h >>> arr (const Mc.noEvent)) [1..value] , bench "machinecell" $ whnf drainMc (Mc.evMap (+) >>> Mc.accum 0)
まとめ
あまり凝ったことをしないならば、今のところpipesが無難だと考えている。しかし、終端処理、シークなどが絡むと、どのライブラリも困難に直面する。決着は未だついていない。
WindowsでのHaskell開発環境構築(2017年秋版)
身の丈に合わないと形容されても仕方ないようなハイスペックなPCを買った。開発環境は当然作り直すことになるので、その軌跡を残しておく。
MSYS2
まずはMSYS2を入れる。これでツールチェーンが揃い、minttyというターミナルエミュレータもついてくる。
$ pacman -Syuu $ pacman -Sy git
stack
Haskellのビルドツールであるstackのインストーラを入手する。処理系から依存パッケージまで無難かつ自動的に用意してくれるので便利だ。
ただしstackはMSYS2上ではうまく動作しない。設定ファイル(デフォルトではC:\sr\config.yaml
)に以下の行を追加し、この問題を回避する。
skip-msys: true
マルチスレッドに強いと評判のRyzen 7を使っているので、並行ビルドで性能を存分に生かしたい。
ghc-options: "*": -j8
パスを通し、stack setup
をすればGHCが使えるようになっているはずだ。
$ export PATH=$PATH:/c/Users/fumieval/AppData/Roaming/local/bin $ stack setup $ stack ghc -- -e 'let s = [Just "let s =",Nothing,Just "in putStrLn $ unwords $ map (maybe (show s) id) s"] in putStrLn $ unwords $ map (maybe (show s) id) s' let s = [Just "let s =",Nothing,Just "in putStrLn $ unwords $ map (maybe (show s) id) s"] in putStrLn $ unwords $ map (maybe (show s) id) s
困ったことに、パッケージをビルドしていると時々以下のようなエラーが出る。どうやらGHCの内部のAPIの呼び方が雑( #10731 (System.IO.openTempFile is not thread safe on Windows) – GHC)らしいので、後でなんとかしたい。
Configuring feeders-0... C:\Users\fumieval\AppData\Local\Temp\: openTempFile: permission denied (Permission denied)
エディタ
すっかりAtom派になった。language-haskell
パッケージを導入すれば準備完了だ。
仮想環境
仕事の環境は基本的にUbuntu 16.04 LTSで統一されている。仕事だけでなく、ライブラリのメンテナンスのためにもLinux環境は手元に欲しい。
VirtualBox 5.1をインストールし、VMの作成に取り掛かる。このタイミングで時間や容量をケチる理由はないので、200GBの固定サイズのディスクを作成した。そして、プロセッサー数と使用率制限、ビデオメモリーは最大に。準仮想化インターフェイスはHyper-Vにし、仮想化支援機能は両方チェックを入れた。とりあえずネットワークアダプターはNATとする。
KDEが好きなのでKubuntuをインストールしたが、なぜか頻繁にクラッシュしてしまう。仕方がないのでPantheonというデスクトップ環境をインストールしてみた。見た目はなかなか悪くない。
sudo add-apt-repository ppa:elementary-os/stable sudo apt update sudo apt install elementary-desktop
もちろんSSHサーバ、Git、stack、Atomなどは入れてすぐ使える。私の会社の場合はChefで設定を管理しているので、knife bootstrap
を実行すれば完成だ。
総評
昔に比べるとWindowsでの環境構築もだいぶ楽になった。
FRPクライシス
FRP(Functional Reactive Programming)は、リアクティブプログラミングと関数型プログラミングの性質を持つプログラミングパラダイムである。FRPは古典的FRPと矢矧のFRPに大別される。
古典的FRP
古典的(Classical)FRPは、非連続的な値の列Eventと、常に何らかの値を取るBehaviourの二種類の構造を導入したものである。 代表的な実装としてreactive-banana、euphoria、reflexなどが挙げられる。
Haskellにおいては、EventはIOを通じて非同期的に生成できる設計が多い。Eventはマップやフィルタリングができ、モノイドとして合成することもできる。なお、GenはFRPの構造を扱うのに要求されるモナドで、実装の都合上しばしば必要となる。Behaviourは現在の値を取り出せる他、HaskellならApplicativeのインスタンスにもなる。「読み取り専用のIO」とも言えるかもしれない。CFRPの構成要素をまとめると以下のようになる。
Eventを畳み込むaccum
が肝で、Behaviorをサンプリングするapply
が心である。
矢矧のFRP
矢矧の(Arrowized)FRPは、値ではなく変換に着目し、値を変換する機構を導入する。Category
及びArrow
のインスタンスであるため、関数と共通の演算を持つ。実装はYampa、wiresなどがある。
(>>>) :: Category (~>) => (b ~> c) -> (a ~> b) -> a ~> c arr :: Arrow (~>) => (a -> b) -> a ~> b (***) :: Arrow (~>) => (a ~> b) -> (c ~> d) -> (a, c) ~> (b, d)
その実態は多くの場合ミーリマシンであり、状態を保持できる。表現する方法は色々あるが、例えば以下のような構造なら、入力に応じて次のMealy
を決めるということができる。
newtype Mealy a b = Mealy { runMealy :: a -> (b, Mealy a b) }
(>>>)
や(***)
などを直接組み合わせるのは骨が折れるが、Arrow記法を用いることで比較的簡単に記述できる。arteryというライブラリでシンセサイザーを実装した例を紹介する。
sineWave :: Artery m (Float, Float) Float -- 周波数と位相を入力とし、正弦波を出力する genADSR :: Float -> Float -> Float -> Float -> Artery m Bool Float -- なめらかな立ち上がり・立ち下がりを持つエンベロープを生成する bell :: Artery m (Float, Bool) Float bell = proc (freq, gate) -> do env <- genADSR 0.01 0.4 0.2 0.4 -< gate m <- sineWave -< (64 * freq, 0) sineWave -< (freq * 2, m * env * 0.5)
入力を明示的に表現する必要があるが、CFRPに比べるとパフォーマンスにおいては優れている傾向がある。また、矢矧のFRPは固有の概念が少ないのも長所である。
FRPの問題点
両者の共通の利点でもあり落とし穴でもあるのは、状態を隠蔽できるというところだ。状態を完全に隠蔽することで組み合わせやすくなる場合もある一方で、一度FRPで構築したものは、状態が隠れているゆえに拡張性が乏しい。古典的FRPにおいては、入力への依存性も隠蔽されているため、特に注意が必要である。隠れた状態が増えるほど、プログラムの性質は複雑で把握するのが難しくなる。同時発生するイベントの処理も注意が必要である。
注意すべきこと
- 何でもFRPで書こうとしない: FRPは、異なった内部状態を隠蔽し、合成可能な共通の型によって扱うことを可能にする。しかし、この利点が活きないような場所に適用すれば、単に再利用性とパフォーマンスが犠牲になるだけである。
- ライブラリのインターフェイスをFRPに限定しない: APIをFRPに限定することは、FRPに起因する問題を回避する手段がないことを意味し、ユーザーにとって足枷となる。FRPのAPIは色々な操作をまとめることで成り立つが、その内部の操作もエクスポートされていれば柔軟な使い方ができる。よっぽどの信念がない限り、FRPはアプリケーションのコードだけにとどめ、ライブラリの実装では使わないのが得策だろう。
- FRPによって何が得られ、何が失われるか常に意識する: FRPでプログラムを表現することは、内部状態にアクセスする、文脈に依存せず動作するという性質を犠牲にして、状態の隠蔽、簡単な合成を可能にする。本当に自信がない限り、FRPを使うべきではない。
- FRPは、プログラムの注意点を増やし、決して減らすことはない: FRPが新たな構造と演算を導入する以上、冗長性をいくらか解消できても、本質的な複雑さをなくすわけではない。安全に使いこなすには仕組みの理解が不可欠であり、多くのCFRPライブラリのように、実装が隠蔽されている場合は特に気をつけるべきである。
FRPの代わりになりうるもの
- STM TVarを中心とする、状態を保持する構造に対する操作(トランザクション)を、STMという専用のモナドで記述する。トランザクションは状態が更新された時に実行されるようにでき、リアクティブな動作を表現できる。並行処理との親和性が高いのも魅力である。
- ストリーム処理ライブラリ 入出力と状態を扱うという面ではFRPとの共通点が多い。何もファイルやネットワークなどに限定する必要はなく、アプリケーションのロジックをストリーム処理ライブラリで記述するのもアリだ。
- objective objectiveはHaskellでオブジェクト指向を実現するライブラリである。オブジェクトは自然変換とミーリマシンの性質を併せ持っており、矢矧のFRPの発展形としても見ることができる。FRPと同様、安易な使用はアンチパターンである。
総評
私は仕事で古典的FRPを使ったコードを保守しているが、(私から見て)過剰に使われているため、かなりの重荷である。少しでもFRPを減らして保守性を高めるべく、繊維強化プラスチックのごとき決意を固めた。
快速のExtensible effects
extensibleは拡張可能レコードだけでなく拡張可能作用(extensible effects)も用意している。拡張可能作用は一時期Haskell界隈で話題になったものの、今では人気も下火になってしまった。新しいバージョンをリリースした今、拡張可能作用の動機と使い方について改めて紹介しよう。
難行の一次関数
Haskellでモナドをカスタマイズする方法としては、transformersのモナド変換子がよく使われている。モナド変換子は、モナドをパラメータとして取り、新たな能力を付与したモナドにする構造だ。例えば、StateT sはモナド変換子の一つである。任意のアクションm a
はlift
を使ってStateT s m a
に変換できる。
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
他にもReaderT, WriterT, MaybeTなどの変換子があり、好きなように組み合わせてモナドを作れる。しかし、変換子を積んだ分だけliftを適用しなければいけないので、そのまま使うのは非常に不便だ。
苦行の二次関数
mtlというライブラリは、モナドの固有アクションを抽象化する型クラスを定義している。
MonadState
はその一つで、関数従属性m -> s
は、m
の型が決まればs
もわかるという制約を示している。もちろんStateTはそのインスタンスになる。
class Monad m => MonadState s m | m -> s where get :: m s put :: s -> m () state :: (s -> (a, s)) -> m a instance Monad m => MonadState s (StateT s m)
ベースのモナドがMonadStateならば、単体ではStateの能力を持たないモナドについてもインスタンスが定義できる。そのため、書き手側がliftを書く必要がなく、使いやすい。
MonadState s m => MonadState s (MaybeT m) MonadState s m => MonadState s (ListT m) (Monoid w, MonadState s m) => MonadState s (WriterT w m) (Monoid w, MonadState s m) => MonadState s (WriterT w m) MonadState s m => MonadState s (IdentityT m) MonadState s m => MonadState s (ExceptT e m) (Error e, MonadState s m) => MonadState s (ErrorT e m) MonadState s m => MonadState s (ReaderT * r m) MonadState s m => MonadState s (ContT * r m)
しかし、モナドを作る側にとっては厄介な代物だ。新しい変換子を作るたび、mtlにある分だけでMonadCont
, MonadError
, MonadReader
, MonadState
, MonadWriter
, MonadIO
の6つのインスタンスを定義しないといけない。しかもMonadCont
とMonadWriter
は単なるlift
では書けずかなり厄介だ。
クラスを作る場合、今度は自前のモナドに加え、AccumT
, ContT
, ExceptT
, IdentityT
, MaybeT
, RWST
二種、ReaderT
, WriterT
二種、StateT
二種の計12個のインスタンスも作らされる。変換子と対応するクラスを作るたびに加速度的に労力が増し、いつかは破綻する。
拡張可能作用
Extensible effectsはモナド変換子の代替として提案された*1。アクションを表すのに、Open unionsと呼ばれる特殊なデータ型を用いる。
data Union r v -- :: [* -> *] -> * -> * inj :: (Functor t, Typeable t, Member t r) => t v -> Union r v
Unionは型レベルリストをパラメータとして取る。そのリストの要素に含まれていれば、inj
関数を和型のコンストラクタのように使える。これをFreeモナドと組み合わせたモナドEff
を導入し、liftいらずにしようという試みだ。
実装はextensible-effectsパッケージとして存在する。アクションがTypeableであることを要求する、データ型が不必要に再定義されているなど、やや引っかかりはある。特に、Typeableの制約ゆえに、多相なアクションはEff
に持ち上げることができず、MonadState
のような関数従属性もない。計算量のオーダーの改善のため「慈悲なき反省」*2を起用しているが、動作は低速である。
より自由な作用
Oleg Kiselyov, Hiromi Ishiiにより、Operationalモナドをベースにした新しい実装が提案された*3。内部表現にはOkasakiの連結可能キューではなく二分木を使っており、パフォーマンスが向上している。
Hackageにはfreerがアップロードされ、freer-effectsに引き継がれた。速度は見違えるほど改善したものの、多相な型が持ち上げられない、型推論がうまくいかないと言った根本的な問題は解決されていない。
全部盛り
extensibleは拡張可能レコードのライブラリである。型に名前をつけて管理するため、多相型が推論の邪魔になることはない。この仕組みを拡張可能作用に応用すれば多相性の問題を解決できると考え、2015年の4月には基礎部分を実装した。「慈悲なき反省」を取り込んだ自前のOperationalモナドライブラリmonad-skeleton
を、拡張可能ヴァリアントと組み合わせただけである。地味に画期的なmtlとの互換性もあったものの、あまり使うあてがなく、長時間放置していた。今年の2月になって急にモチベーションが向上し、まともな拡張可能作用のライブラリとして使えるようにAPIを整えた。
mtlの代替が基本の使い方である。まずはモジュールをインポートする。
import Control.Monad.State.Class import Data.Extensible.Effect import Data.Extensible.Effect.Default
アクションはmtl
と互換性がある。lens
の演算子などももちろん利用可能だ。このような多相なパラメータをもつアクションを試してみよう。
increment :: (Num a, MonadState a m) => m () increment = modify (+1)
アクションを実行するには、Data.Extensible.Effect.Defaultモジュールのrun...Def
とleaveEff
を使う。
runStateDef :: Eff (StateDef s ': xs) a -> s -> Eff xs (a, s) leaveEff :: Eff '[] a -> a
*Main> leaveEff $ runStateDef increment 0 ((),1)
ReaderT r (WriterT w (State s))
に対応するモナドはEff '[ReaderDef r, WriterDef w, StateDef s]
で、覚えるのは難しくないだろう。実行するにはrunReaderDef
, runWriterDef
, runStateDef
で、leaveEff
で締めくくる。
好きな名前を与えることもでき、同じ型を持つ作用を複数持たせることもできる。その場合、Eff '["foo" >: WriterEff String, "bar" >: WriterEff String]
のように書く。
名前付きのアクションはEff
が名前に入っている。OverloadedLabels拡張を使うと簡単に作用名を指定できる(GHC 8.0の型推論器の制約上、Proxyが必要だった)。
test :: (Associate "foo" (WriterEff String) xs, Associate "bar" (WriterEff String) xs) => Eff xs () test = do tellEff #foo "Hello " tellEff #bar "hoge" tellEff #foo "world" tellEff #bar "fuga"
実行するときはTypeApplicationsを使う。
> leaveEff $ runWriterEff @ "foo" $ runWriterEff @ "bar" test (((),"hogefuga"),"Hello world")
自前のアクションを持ち上げるにはliftEff
、分解するにはpeelEff1
を使おう。
liftEff :: forall s t xs a. Associate s t xs => Proxy s -> t a -> Eff xs a peelEff1 :: forall k t xs a b r. (a -> b -> Eff xs r) -- ^ 結果を返す -> (forall x. t x -> (x -> b -> Eff xs r) -> b -> Eff xs r) -- ^ アクションを解釈する -> Eff (k >: t ': xs) a -> b -> Eff xs r -- ^ bは状態を表す変数
物好きならば、peelAction0
を使ってみるのも面白いだろう。Action [a, b, c] r
はa -> b -> c -> E r
を固有アクションとして持つ作用E
に相当する型で、自分でデータ型を定義することなく作用を扱える。decEffects
にGADTの定義を食わせることで、アクションをTHで自動生成できるぞ。
peelAction0 :: forall k ps q xs a. Function ps (Eff xs q) -> Eff (k >: Action ps q ': xs) a -> Eff xs a
decEffects [d| data Blah a b x where Blah :: Int -> a -> Blah a b b |]
は
type Blah a b = "Blah" >: Action '[Int, a] b blah :: forall xs a b. Associate "Blah" (Action '[Int, a] b) xs => Int -> a -> Eff xs b
に変換される。
ベンチマーク
RWS相当のモナドのベンチマークをした。 さすがに階層の浅いモナド変換子には及ばないものの、新しめの実装であるfreer-effectsの倍以上の速度で、なかなか良好と言えるだろう。
benchmarking rws/extensible time 11.63 μs (11.33 μs .. 11.95 μs) 0.995 R² (0.993 R² .. 0.997 R²) mean 11.79 μs (11.49 μs .. 12.03 μs) std dev 847.4 ns (737.1 ns .. 984.8 ns) variance introduced by outliers: 76% (severely inflated) benchmarking rws/mtl time 909.5 ns (890.9 ns .. 928.4 ns) 0.997 R² (0.995 R² .. 0.998 R²) mean 896.4 ns (882.1 ns .. 916.9 ns) std dev 56.40 ns (45.09 ns .. 79.70 ns) variance introduced by outliers: 76% (severely inflated) benchmarking rws/mtl-RWS time 721.7 ns (713.3 ns .. 729.6 ns) 0.999 R² (0.998 R² .. 0.999 R²) mean 721.5 ns (714.2 ns .. 730.4 ns) std dev 27.47 ns (22.82 ns .. 38.35 ns) variance introduced by outliers: 54% (severely inflated) benchmarking rws/exteff time 150.5 μs (145.3 μs .. 156.1 μs) 0.992 R² (0.987 R² .. 0.995 R²) mean 148.5 μs (145.3 μs .. 152.7 μs) std dev 11.89 μs (9.974 μs .. 14.74 μs) variance introduced by outliers: 72% (severely inflated) benchmarking rws/effin time 40.77 μs (39.97 μs .. 41.87 μs) 0.994 R² (0.991 R² .. 0.997 R²) mean 41.97 μs (40.98 μs .. 43.27 μs) std dev 3.509 μs (2.887 μs .. 4.246 μs) variance introduced by outliers: 78% (severely inflated) benchmarking rws/freer-effects time 25.26 μs (24.60 μs .. 25.86 μs) 0.992 R² (0.983 R² .. 0.996 R²) mean 26.28 μs (24.55 μs .. 31.05 μs) std dev 8.954 μs (2.011 μs .. 17.52 μs) variance introduced by outliers: 99% (severely inflated)
Stackageのnightly-2017-07-31 (GHC 8.2)を使用した。
まとめ
既存の拡張可能作用の実装は、型とパフォーマンスの二つの問題を抱えていた。しかし、extensibleはその両方を解決し、拡張可能レコードも付いたお得なパッケージにまとまっている。実用的な局面にも十分に通用する使い心地を保証しよう。
リンク
*1:Oleg Kiselyov et al. http://okmij.org/ftp/Haskell/extensible/exteff.pdf, 2013
*2:Atze van der Ploeg and Oleg Kiselyov, Reflection Without Remorse, http://okmij.org/ftp/Haskell/zseq.pdf, 2014