mike-neckのブログ

Java or Groovy or Swift or Golang

Freeモナドを使ってIOアクションをモッキングする的な

Freeモナドがすごい的な話がおよそ4〜5年前くらいに流行ってたのだが、その頃はHaskellなど触ってなかった僕には関係のない話でした。

Haskellを触ってて、IOアクションのあるようなプログラムをテスト的に動かしてみようとすると途端に困るわけです。

例えば 0 が入力されるまでに入力された正の数値の合計を出力するプログラムを考えます。

getSum :: Int -> IO Int
getSum s = do
  i <- readLn
  case I `compare` 0 of
    LT -> getSum s
    EQ -> return s
    GT -> getSum $ I + s

main :: IO ()
main = do
  s <- getSum 0
  print s

さて、このプログラムをテストすることを考えます。考えますが、こんなのコンパイルして手打ちで値を入力すればokですね。でも、そうではないんですよ。テストは極力自動でできるようにしておきたいのですよ。HUnitとかQuick Checkとかぶっこんだところで、どうやって readLn 関数から値を入れればいいのでしょう?

ということで、ここで登場するのがFreeモナドらしいわけです。

Freeモナドでモックするあたりについては次のエントリーStackoverflowが詳しいです。

d.hatena.ne.jp

stackoverflow.com

{-# LANGUAGE DeriveFunctor #-}
module MockIO where

import Control.Monad.Trans.Free
import Data.Foldable(traverse_)
import Data.IORef

-- 各IO関数を表す型の定義
data StrIO n = GetLine (String -> n) | PutStrLn String n deriving (Functor)

-- FreeモナドでくるんだIO関数型
-- ActionはFreeT StrIO IOなのでMonad
type Action n = FreeT StrIO IO n

-- プログラムから呼び出すIO関数(IO関数型を返す)
-- getLineに相当する関数
getString :: Action String
getString = liftF $ GetLine id
-- putStringに相当する関数
putString :: String -> Action ()
putString s = liftF $ PutStrLn s ()

ここまでの StrIO の定義によって、各プログラムが呼び出すIO関数を標準入出力から内部的な入出力を模した関数へと変更できるようになります。

そして、先程の 0 が入力されるまでの合計を出力するプログラムは次のように書き直せます。

-- readLnを表す型を作ってないのでStringを受け取ってIntとして読み込む関数を作っておく
-- getLine(:: IO String)の代わりにgetString(:: Action String)関数を用いる
getInt :: Action Int
getInt = fmap read getString

getSum :: Int -> Action Int
getSum s = do
  I <- getInt
  case I `compare` 0 of
    LT -> getSum s
    EQ -> return s
    GT -> getSum $ I + s

-- main関数の代わりにアプリを表す関数
app :: Action ()
app = do
  s <- getSum
  putString $ show s

そして、 Action aIO a に模す関数を作ります。

-- Action a を IO a に変換する関数が 動作モードなので、これを RunMode a と名付ける
type RunMode a = Action a -> IO a

-- 標準入力に接続する関数
stdIO :: RunMode a
stdIO io = do
  iterT go io
  where
    go (PutStrLn s n) = putStrLn s >> n
    go (GetLine f)    = getLine >>= f

-- Stringのリストを入力として扱う関数
debugIO :: [String] -> RunMode a
debugIO txt io = do
  que <- newQue txt
  iterT (go que) io
  where
    newQue = newIORef . cycle
    go _   (PutStrLn s n) = putStrLn s >> n
    go que (GetLine f)    = do
      txt <- popQue que
      f txt
      where
        popQue ref = atomicModifyIORef ref $ \(x:xs) -> (xs, x)

-- RunMode a を受け取って、実際にアプリケーション(:: Action a) を IO a に変換する関数
runAppOn :: RunMode a -> Action a -> IO a
runAppOn f = f

最後に定義した runAppOn 関数を main にて呼び出します。

main = IO ()
main = let dummy = fmap show $ [1..5] ++ [0] in
  runAppOn (debugIO dummy) app

これで、手で数値を入力しなくてもアプリケーションを試せるようになりました。

(眠いので)おわり