method-0.3でHaskellでのTDDをもっと楽しくする
はじめに
先日リリースしたHaskellのモックライブラリmethodの新バージョンをリリースしました。
前回の記事は こちらです。
この記事では今回追加した次の二つの新機能を紹介します。
- 複数のメソッドの使われ方を同時にテストする機能
- 多相メソッドをモックする機能
新機能1: Protocol
モックメソッドが呼び出されたかどうかをテストするにはMonitor
をつかうことができました。
しかし、Monitor
は一つのメソッドの呼ばれ方をテストするのには適していますが、
複数のメソッドの呼ばれ方をテストするのは大変です。
新しいProtocol DSLを使うと、
- 複数のメソッドがどのような順序・引数で何回呼び出されるかテストできます
- モックの振る舞いと呼び出し仕様を一つのDSLで記述できます。
使い方
例としてサインアップロジックをテストすることを考えましょう。
{-# LANGUAGE RecordWildCards #-}
module Signup where
import RIO(bracketOnError_)
type UserName = String
type UserId = Int
type Password = String
data Service = Service {
findUser :: UserName -> IO (Maybe UserId),
createUser :: UserName -> IO UserId,
setPassword :: UserName -> Password -> IO (),
beginTransaction :: IO (),
commitTransaction :: IO (),
rollbackTransaction :: IO ()
}
signup :: Service -> UserName -> Password -> IO (Maybe UserId)
signup Service{..} usernm passwd = do
mId <- findUser usernm
case mId of
Just _ -> pure Nothing
Nothing -> bracketOnError_ beginTransaction rollbackTransaction $ do
userId <- createUser usernm
setPassword usernm passwd
commitTransaction
pure $ Just userId
このsignup
メソッドは6つのメソッドに依存しています。
このメソッドが以下の仕様を満たしているかテストします。
-
findUser
がJust userId
を返した場合、何もせずNothing
を返す -
findUser
がNothing
を返した場合、- トランザクションを開始し、
createUser
とsetPassword
を呼び出し(呼び出し順不同)コミットし、createUser
の返り値をJust
に包んで返す。 - トランザクション途中で例外が発生した場合、メソッドもその例外を投げ、トランザクションをロールバックする
- トランザクションを開始し、
それではテストを書いていきましょう。今回使う言語拡張とモジュールは以下のとおりです。
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
module SignupSpec where
import RIO
import Test.Hspec
import Test.Method
import Signup
Protocol DSLでは複数のメソッドを識別するために、メソッドの名前と型を紐づけたGADTを定義します。
data Methods m where
FindUser :: Methods (UserName -> IO (Maybe UserId))
CreateUser :: Methods (UserName -> IO UserId)
SetPassword :: Methods (UserName -> Password -> IO ())
BeginTransaction :: Methods (IO ()),
CommitTransaction :: Methods (IO ()),
RollbackTransaction :: Methods (IO ())
deriving instance Eq (Methods m)
deriving instance Ord (Methods m)
deriving instance Show (Methods m)
まずは一つ目の仕様を書いてみましょう。
spec :: Spec
spec = describe "signup" $ do
let usernm = "user1"
passwd = "pass1"
userId = 0
context "`findUser`が`Just userId`を返した場合" $ do
it "何もせず`Nothing`を返す" $ do
penv <- protocol $ do
decl $ whenArgs FindUser (==usernm) `thenReturn` Just userId
let service = mkService penv
signup service usernm passwd `shouldReturn` Nothing
verify penv
mkService :: ProtocolEnv Methods -> Service
mkService env = Service {
findUser = lookupMock FindUser env,
createUser = lookupMock CreateUser env,
setPassword = lookupMock SetPassword env,
beginTransaction = lookupMock BeginTransaction env,
commitTransaction = lookupMock CommitTransaction env,
rollbackTransaction = lookupMock RollbackTransaction env
}
protocol
の引数に依存メソッドのふるまい(プロトコル)を記述します。
protocol $ do
decl $ whenArgs FindUser (==usernm) `thenReturn` Just userId
このプロトコルでは、「findUser
メソッドをちょうど一回呼び出す。そのときの引数はusernm
と等しく、返り値は Just userId
である」ということを表します。
また、暗黙的にそのほかのメソッドは呼び出さないということも意味しています。
protocol
関数はProtocolEnv Methods
を返します。この環境からモックメソッドを
lookupMock
を使って取り出すことができます。
mkService :: ProtocolEnv Methods -> Service
mkService env = Service {
findUser = lookupMock FindUser env,
createUser = lookupMock CreateUser env,
setPassword = lookupMock SetPassword env,
beginTransaction = lookupMock BeginTransaction env,
commitTransaction = lookupMock CommitTransaction env,
rollbackTransaction = lookupMock RollbackTransaction env
}
これらのモックメソッドはプロトコルで指定した通りに動作し、それ以外の使い方をすると例外を投げます。
最後にverify
を呼び出し、プロトコルで指定された呼び出しのうち未発火のものがないかテストします。
signup service usernm passwd `shouldReturn` Nothing
verify penv
このテストを実行すると無事成功します。
一方、signup
の実装を以下のように変えるとテストは失敗します。
signup :: Service -> UserName -> Password -> IO (Maybe UserId)
signup Service {..} usernm passwd = do
mId <- findUser usernm
bracketOnError_ beginTransaction rollbackTransaction $ case mId of
Just _ -> pure Nothing
Nothing -> do
userId <- createUser usernm
setPassword usernm passwd
commitTransaction
pure $ Just userI
Failures:
test/SignupSpec.hs:30:5:
1) Signup.signup, `findUser`が`Just userId`を返した場合, 何もせず`Nothing`を返す
uncaught exception: ErrorCall
0-th call of method BeginTransaction is unspecified
CallStack (from HasCallStack):
error, called at src/Test/Method/Protocol.hs:189:7 in mthd-0.3.0.0-cb36a25c:Test.Method.Protocol
CallStack (from -prof):
Test.Method.Protocol.lookupMockWithShow (src/Test/Method/Protocol.hs:(186,1)-(209,36))
Test.Method.Protocol.lookupMock (src/Test/Method/Protocol.hs:170:1-48)
SignupSpec.mkService (test/SignupSpec.hs:(38,1)-(46,5))
Test.Hspec.Expectations.shouldReturn (src/Test/Hspec/Expectations.hs:129:1-65)
SignupSpec.spec (test/SignupSpec.hs:(25,1)-(35,17))
ログを読むと無駄にトランザクションを開始しているのが原因だとすぐにわかります。
さて、次の仕様のテストを追加しましょう。
spec :: Spec
spec = do
...
context "`findUSer`が`Nothing`を返した場合" $ do
it "トランザクションを開始し、`createUser` と`setPassword`を呼び出し(呼び出し順不同)コミットし、`createUser`の返り値を `Just`に包んで返す。" $ do
penv <- protocol $ do
findUserCall <-
decl $
whenArgs FindUser (== usernm) `thenReturn` Nothing
beginCall <-
decl $
whenArgs BeginTransaction () `thenReturn` ()
`dependsOn` [findUserCall]
createUserCall <-
decl $
whenArgs CreateUser (== usernm) `thenReturn` userId
`dependsOn` [beginCall]
setPasswordCall <-
decl $
whenArgs SetPassword ((== usernm), (== passwd)) `thenReturn` ()
`dependsOn` [beginCall]
decl $
whenArgs CommitTransaction () `thenReturn` ()
`dependsOn` [createUserCall, setPasswordCall]
let service = mkService penv
signup service usernm passwd `shouldReturn` Just userId
verify penv
一つ目のプロトコルに比べると複雑ですが、呼び出すべきメソッドを順番に書いているだけです。
着目して欲しいところは dependsOn
を用いてメソッドの呼び出し順を指定している点です。
このプロトコルでは createUser
と setPassword
は順不同ですが、beginTransaction
を
createUser
よりも後に呼び出すことはできません。
例えば、signup
の実装を以下のようにするとテストが失敗します。
signup :: Service -> UserName -> Password -> IO (Maybe UserId)
signup Service {..} usernm passwd = do
mId <- findUser usernm
case mId of
Just _ -> pure Nothing
Nothing -> do
userId <- createUser usernm
bracketOnError_ beginTransaction rollbackTransaction $ do
setPassword usernm passwd
commitTransaction
pure $ Just userId
Failures:
test/SignupSpec.hs:37:5:
1) Signup.signup.`findUser`が`Nothing`を返した場合 トランザクションを開始し、`createUser` と`setPassword`を呼び出し(呼び出し順不同)コミットし、`createUser`の返り値を `Just`に包んで返す。
uncaught exception: ErrorCall
dependent method BeginTransaction is not called: CallId {unCallId = 1}
CallStack (from HasCallStack):
error, called at src/Test/Method/Protocol.hs:207:21 in mthd-0.3.0.0-cb36a25c:Test.Method.Protocol
CallStack (from -prof):
Test.Method.Protocol.lookupMockWithShow (src/Test/Method/Protocol.hs:(186,1)-(209,36))
Test.Method.Protocol.lookupMock (src/Test/Method/Protocol.hs:170:1-48)
SignupSpec.mkService (test/SignupSpec.hs:(62,1)-(70,5))
Signup.signup (src/Signup.hs:(23,1)-(32,26))
最後の仕様のテストも追加しましょう。
spec :: Spec
spec = do
...
context "`findUser`が`Nothing`を返した場合" $ do
...
context "トランザクション途中で例外が発生した場合" $ do
it "その例外を投げ、トランザクションをロールバックする" $ do
penv <- protocol $ do
findUserCall <-
decl $
whenArgs FindUser (== usernm) `thenReturn` Nothing
beginCall <-
decl $
whenArgs BeginTransaction () `thenReturn` ()
`dependsOn` [findUserCall]
createUserCall <-
decl $
whenArgs CreateUser (== usernm) `thenAction` throwString "DB Error"
`dependsOn` [beginCall]
decl $
whenArgs RollbackTransaction () `thenReturn` ()
`dependsOn` [createUserCall]
let service = mkService penv
anyStringException :: StringException -> Bool
anyStringException _ = True
signup service usernm passwd `shouldThrow` anyStringException
verify penv
ついうっかりrollbackをするのを忘れたとしましょう。
signup :: Service -> UserName -> Password -> IO (Maybe UserId)
signup Service {..} usernm passwd = do
mId <- findUser usernm
case mId of
Just _ -> pure Nothing
Nothing -> do
beginTransaction
userId <- createUser usernm
setPassword usernm passwd
commitTransaction
pure $ Just userId
テストが失敗するので安心です。
Failures:
test/SignupSpec.hs:62:7:
1) Signup.signup.`findUser`が`Nothing`を返した場合.トランザクション途中で例外が発生した場合 その例外を投げ、トランザクションをロールバックする
uncaught exception: ErrorCall
method RollbackTransaction should be called 1 times, but actually is called 0 times
CallStack (from HasCallStack):
error, called at src/Test/Method/Protocol.hs:242:7 in mthd-0.3.0.0-cb36a25c:Test.Method.Protocol
CallStack (from -prof):
Test.Method.Protocol.verify (src/Test/Method/Protocol.hs:(237,1)-(246,21))
SignupSpec.spec (test/SignupSpec.hs:(26,1)-(82,19))
新機能2: 多相関数のモック
mockup
を使うとメソッドをモックすることができますが、多相型のメソッドをうまくモックする事はできません。
今回、Dynamic
型を用いて多相型をもつメソッドもうまくモックできるようになりました。
使い方
例えば、 postgresql-simpleの query
関数を使ったプログラムのテストをしたい場合を考えましょう。
query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]
{-# LANGUAGE OverloadedStrings #-}
module Repository where
import Database.PostgreSQL.Simple
type UserName = String
type UserId = Int
findUser :: Connection -> UserName -> IO (Maybe UserId)
findUser conn usernm = do
r <- query conn "SELECT user_id FROM user WHERE user_name = ?" (Only usernm)
case r of
[Only userId] -> pure $ Just userId
_ -> pure $ Nothing
このままだとquery
関数を注入できないので、DIできる形に書き直します。
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Repository where
...
newtype QueryService = QueryService
{ queryService :: forall q r. (ToRow q, FromRow r) => Query -> q -> IO [r]
}
findUser :: Connection -> UserName -> IO (Maybe UserId)
findUser conn =
findUserQ (QueryService (query conn))
findUserQ :: QueryService -> UserName -> IO (Maybe UserId)
findUserQ svc usernm = do
r <- queryService svc "SELECT user_id FROM user WHERE user_name = ?" (Only usernm)
case r of
[Only userId] -> pure $ Just userId
_ -> pure Nothing
つぎに、 モックするメソッドの各型変数の型制約にTypeable
とShow
を追加します。
Typeable
はGHCが勝手にインスタンスを生成してくれるので、制約が強まるわけではありません。
Show
は実装できない場合、制約つけなくてもよいです。(つけたほうがデバッグしやすくなります)
今回はq
にTypeable
とShow
を追加し、r
にTypeable
を追加します。
import Data.Typeable
...
data QueryService = QueryService {
queryService :: forall q r. (ToRow q, Typeable q, Show q, FromRow r, Typeable r)
=> Query -> q -> IO [r]
}
これでProductionコードの準備ができました。
テストコードにて次のようにするとQueryService
をモックできるようになります。
-
型変数
q
をDynamicShow
にr
をDynamic
[1]にそれぞれ置換したモックメソッドを作成します。queryD :: Query -> DynamicShow -> IO [Dynamic] -- 型宣言は省略できません queryD = mockup $ do when (args ((== sql), dynArg (== Only "user1"))) `thenReturn` toDyn [Only 0 :: Only UserId] sql = "SELECT user_id FROM user WHERE user_name = ?"
引数のMatcherは
dynArg
を使うとDynamic
型(またはDynamicShow
型)のMatcherに変換することができます。また、
返り値はtoDyn
を使ってDynamic
型(またはDynamicShow
型)に変換できます。[2] -
castMethod
を使ってDynamic版のメソッドを多相型のメソッドに変換します。svc :: QueryService svc = QueryService (castMethod queryD)
テストコード全体はつぎのようになります。
{-# LANGUAGE OverloadedStrings #-}
module RepositorySpec where
import Database.PostgreSQL.Simple
import Repository
import Test.Hspec
import Test.Method
spec :: Spec
spec = describe "findUser" $ do
let usernm = "user1"
userId = 0
context "`query`の結果が1行の時" $ do
it "`Just userId`を返す" $ do
let queryD :: Query -> DynamicShow -> IO [Dynamic]
queryD = mockup $ do
when (args ((== sql), dynArg (== Only usernm))) `thenReturn` toDyn [Only userId]
sql = "SELECT user_id FROM user WHERE user_name = ?"
findUserQ (QueryService (castMethod queryD)) usernm `shouldReturn` Just userId
context "`query`の結果が0行の時" $ do
it "`Nothing`を返す" $ do
let queryD :: Query -> DynamicShow -> IO [Dynamic]
queryD = mockup $ do
when (args ((== sql), dynArg (== Only usernm))) `thenReturn` toDyn ([] :: [Only UserId])
sql = "SELECT user_id FROM user WHERE user_name = ?"
findUserQ (QueryService (castMethod queryD)) usernm `shouldReturn` Nothing
まとめ
- Protocolを使うと、複数の依存メソッドをもつ関数のテストすることができます。
- 依存メソッドがどのような順序で、どの引数で呼ばれ、そのときの返り値は何なのかを記述できます。
- 記述した振る舞いと異なる呼び出し方をした場合、例外として検出されます。
- 多相型のメソッドはDynamic型をつかった単相メソッドとしてモックすることができます。
- 二つの機能は直交しているので組み合わせることも可能です。
モックライブラリmethodは以下で開発されています。Issueお待ちしております。
Discussion