主としてテスト時のために、現在時刻を操作する Haskell ライブラリを作成しました。Hackage にも登録済みです。
試しに次のコードを実行してみましょう。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
が提供する主な関数は travelTo
、jumpTo
、accelerate
の 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 を返すので、実際には時差を補正した時刻が表示されることになります。
「行き先」となる時刻の指定にはいくつかの方法があります。
行き先を指定するための DSL は Control.Monad.TimeMachine.Cockpit
モジュールに定義されており、例えば travelTo (3 `days` ago)
のような自然言語っぽい記述ができるようになっています。ちなみにこの記事の冒頭で登場した backTo
も travelTo
のエイリアスです。
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
を流用しています。
getCurrentTZ
と getCurrentTimeScale
は一つのコンテクスト内では変化しないので実質単なる 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
travelTo
、jumpTo
、accelerate
の実体はこの TimeMachineT
を run
するための関数です。
IO
もまた MonadTime
のインスタンスになっており、かつ本物の getCurrentTime
や getCurrentTZ
が実装として指定されているため、IO
内で呼ばれた場合には真の現在時刻が返る、という仕組みになっています。
まとめ
今回作成したライブラリ time-machine
を使用すると、delorean
や timecop
の Ruby gem と同様、現在時刻をモックして時刻依存の関数の挙動を外から操作できるようになります。
内部では型クラスを用いて実装されており、コンテクストによって getCurrentTime
の挙動が変わることを利用しています。
なお、型クラスとモナド変換子を同様の考え方で用いることで、時刻に限らず一般に副作用をモックするライブラリとして monad-mock があります。こちらは Template Haskell を使っていたりしてもっと複雑ですが、それはまた別の話。