チェシャ猫の消滅定理

数学にプログラミング、素敵なもの何もかも。

現在時刻をモックする Haskell ライブラリ time-machine を作ってみました

主としてテスト時のために、現在時刻を操作する Haskell ライブラリを作成しました。Hackage にも登録済みです。

github.com

試しに次のコードを実行してみましょう。getCurrentTime しているはずなのに、返ってくる値が 1985 年 10 月 26 日になっているはずです。

module Main where

import Control.Monad.TimeMachine
import Control.Monad.Trans ( liftIO )

main :: IO ()
main = backTo (the future) $ do
    t <- getCurrentTime
    liftIO . putStrLn $ "We are at " ++ show t

作成の動機

一般論として、現在時刻に依存する関数やメソッドはテストが難しくなります。例えば次の関数を考えましょう。

getGreeting :: IO String
getGreeting = do
    t <- getCurrentTime
    if utctDayTime t <= 12 * 60 * 60
        then return "Good morning"
        else return "Hello"

この関数は午前中には "Good morning" を、午後には "Hello" を返しますが、時刻に依存して結果が変わってしまうため当然このままではテストできません。最初から時刻を引数として渡すようにするのも一つの方法ではありますが、今回はちょっと別の選択肢を考えます。

今回作成したライブラリ time-machine を用いると、関数の中身はそのまま型だけ変更して

getGreeting :: (MonadTime m) => m String
getGreeting = do
    t <- getCurrentTime
    if utctDayTime t <= 12 * 60 * 60
        then return "Good morning"
        else return "Hello"

としておくことで、内部の getCurrentTime が返す時刻を自由に操作できるようになります。もちろん、普通に IO モナドのコンテクストでこの関数を呼んだ場合には普通に現在時刻を返して来るようになっています。

ちなみに、Ruby ではテスト時に現在時刻をモックするための gem として以下の 2 つがよく知られています。

今回のライブラリはこの gem から着想を得ています。モナドによる DSL を用いることで、同様の効果をより Haskell らしい方法で実現することを目指しました。

使い方

ライブラリ time-machine が提供する主な関数は travelTojumpToaccelerate の 3 つです。使用することでモナドのコンテクストに入り、コンテクスト内で getCurrentTime など現在時刻に依存する IO アクションを使用するとモックされた値が返ってきます。

以下では具体的な使い方について説明します。なお各関数は独立した効果を持ちますが、モナド入れ子にすることで複数の効果を同時に得ることも可能です。

travelTo

現在の(グローバルな)時刻を変化させます。タイムゾーンは変わりません。timecop の travel に相当します。

main = travelTo (oct 26 1985 am 1 24) $ do
    getCurrentTime >>= (liftIO . print)

このコードでは、現在のタイムゾーンにおける 1985 年 10 月 26 日 AM 1:24 を指定しています。getCurrentTimeタイムゾーンに関係なく UTC を返すので、実際には時差を補正した時刻が表示されることになります。

「行き先」となる時刻の指定にはいくつかの方法があります。

  1. 直接 UTC を指定する
  2. 現在のタイムゾーンにおける時刻を指定する(上の例)
  3. 現在との相対時刻を指定する

行き先を指定するための DSLControl.Monad.TimeMachine.Cockpit モジュールに定義されており、例えば travelTo (3 `days` ago) のような自然言語っぽい記述ができるようになっています。ちなみにこの記事の冒頭で登場した backTotravelToエイリアスです。

jumpTo

travelTo とは逆に、現在時刻 (UTC) を保ったまま loadLocalTZ の結果を変化させます。

import qualified Data.Time.Zones as TZ

main = jumpTo "Asia/Shanghai" $ do
    t  <- getCurrentTime
    tz <- loadLocalTZ
    liftIO . print $ TZ.timeZoneForUTCTime tz t  -- CST

なお loadLocalTZ だけではタイムゾーンが確定しないことに注意しましょう。これは、同じ地域でも UTC によってサマータイムになるかどうかが変わるためですが、time-machineサマータイムも含めて正しく扱えるようになっているはずです。

accelerate

時間が進む速さを変化させます。timecop の scale に相当します。

main = accelerate (x 60) $ do
    getCurrentTime >>= (liftIO . print)  -- (1)
    liftIO . threadDelay $ 1000 * 1000
    getCurrentTime >>= (liftIO . print)  -- (2)

このコードでは実時間 1 秒(1000 * 1000 マイクロ秒)のディレイが入っていますが、(2) で表示される時刻は (1) で表示される時刻の約 1 分後になります。これは accelerate (x 60) の効果で、コンテクスト内部の時間が 60 倍に加速しているためです。

なお、accelerate の特殊な場合として halt が用意されています。コンテクスト内で時間のかかる処理を行っても時刻が変化しなくなるため、travelTo を組み合わせて使用すると、テストしたい処理自身の実行にかかる時間を無視して狙った時刻をピンポイントに作り出すことができます。timecop の freeze に相当する機能です。

main = halt $ do
    travelTo (jan 1 1970 am 0 0) $ do
        ....

仕組み

裏側の仕組みはシンプルで、型クラスを使うことでコンテクストによって挙動を変化させています。型クラス MonadTime には、モナドのコンテクスト内部において時刻の情報を返すための関数が定義されています。

class (Monad m) => MonadTime m where
    getCurrentTime      :: m T.UTCTime
    getCurrentTZ        :: m TZ.TZ
    getCurrentTimeScale :: m TimeScale

実際にモックされた時刻のコンテクストを保持しているのはモナド変換子 TimeMachineT で、実装には ReaderT を流用しています。

getCurrentTZgetCurrentTimeScale は一つのコンテクスト内では変化しないので実質単なる ask をそのまま使っていますが、getCurrentTime は「travelTo したあとそのコンテクスト内で経過した時間」が必要なので別途算出しています。

instance (MonadIO m) => MonadTime (TimeMachineT m) where
    getCurrentTime = TimeMachineT $ do
        realCurr <- liftIO T.getCurrentTime
        Spacetime simOrigin realOrigin _ scale <- ask
        let diff = scaledDiffUTCTime scale realCurr realOrigin
        return $ T.addUTCTime diff simOrigin

    getCurrentTZ        = TimeMachineT $ ask >>= return . stTZ
    getCurrentTimeScale = TimeMachineT $ ask >>= return . stTimeScale

travelTojumpToaccelerate の実体はこの TimeMachineTrun するための関数です。

IO もまた MonadTimeインスタンスになっており、かつ本物の getCurrentTimegetCurrentTZ が実装として指定されているため、IO 内で呼ばれた場合には真の現在時刻が返る、という仕組みになっています。

まとめ

今回作成したライブラリ time-machine を使用すると、deloreantimecopRuby gem と同様、現在時刻をモックして時刻依存の関数の挙動を外から操作できるようになります。

内部では型クラスを用いて実装されており、コンテクストによって getCurrentTime の挙動が変わることを利用しています。

なお、型クラスとモナド変換子を同様の考え方で用いることで、時刻に限らず一般に副作用をモックするライブラリとして monad-mock があります。こちらは Template Haskell を使っていたりしてもっと複雑ですが、それはまた別の話。