json-tracerなるライブラリを作った

はじめに

ある程度大きなプログラムを作ると、いろいろなログを書きだしたくものである。 しかしログというのは文字列ベースなものであり、かつプログラムの構造とは関係なく、一列に並んでしまうものである。 そのため、プログラムの中でどのような計算が行われているかを表すために、一列に並ぶのではなく、木構造を持ったログを出力したくなった。

こういう時に行儀のよいHaskellerならログのデータ構造を定義し始めるのだが、何をログに残すかは開発の途中で頻繁に変わるものであるし、実行のパラメータによって計算の過程は変わったりするものでもあるので、簡単にログの構造を書き換えられるようなものでなければならない。もちろん型安全性を犠牲にすることはゆるされない。

今回作ったjson-tracerというライブラリはそのような木構造ログを可能にするものである。 このライブラリではログは型つきのjsonデータとして計算される。

json-tracer: A polymorphic, type-safe, json-structured tracing library

このライブラリでは2つのモジュールを提供している

  • Data.PolyDict: 型安全かつ多相な辞書オブジェクト
  • Control.Monad.Trace: 文脈に応じたログを可能とするモナド

PolyDict

このライブラリではログはJSONと互換性のあるDict nという型に保存する。 ライブラリのユーザはまずフィールドの名前空間を表す型を定義する。

data Main

そして、Dict nの各フィールドがどのような型を持つかをAssoc n kのルールを追加することで記述する。

type instance Assoc Main "elapsed_time" = NominalDiffTime
type instance Assoc Main "tag" = String

こうすると、Dict Mainにおいて、フィールド"elapsed_time"に束縛できる値の型はNominalDiffTimeであり、フィールド"tag"に束縛できる値はString型となる。

type familyの定義はopenなので、一つのモジュールに全てのフィールド定義を書く必要はない。また嬉しいことに、同じフィールドを複数箇所で定義してしまった場合はコンパイラがエラーとして報告してくれる。

Assok n kのルールの右辺に書く型はDictValueの制約を満たさなければならない。

type family DictValue v :: Constraint where
    DictValue v = (Eq v, Show v, ToJSON v)

ToJSON vを満たす型ならば大抵DictValue vの制約も満たせるのでJSONに書ける型なら右辺に書くことができる。

Dict nのフィールドにはlookup, insertを用いてアクセスすることができる。

lookup :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Dict n -> Maybe v
insert :: (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> v -> Dict n -> Dict n

Key kはフィールドを表す型レベルシンボルのProxyとなっている。OverloadedLabels拡張を用いて#foo"foo"のフィールドにアクセスできる。

ghci> let v = insert #tag "sample" empty 
ghci> v
{"tag": "sample"}
ghci> lookup #tag v
Just "sample"
ghci> lookup #elapsed_time v
Nothing

lookup #tagの型はMaybe Stringだがlookup #elapsed_timeの型はMaybe NominalDiffTimeとなるわけだ。型レベルシンボルはまるで魔法のようである。

あるいはLensを用いたアクセスも可能である。

access  :: forall n k v. (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> Lens' (Dict n) (Maybe v)
access' :: forall n k v. (KnownSymbol k, DictValue v, Assoc n k ~ v) => Key k -> v -> Lens' (Dict n) v

ghci> let v = empty & access #tag ?~ "sample"
ghci> v
{"tag": "sample"}
ghci> v ^. access #tag
Just "sample"

Tracer Monad

TracerT c m aというモナドトランスフォーマが木構造のログを可能にする。 このモナドではupdatezoomという二つのアクションが実行できる。

updateは文脈の値を更新するアクションだ。

update :: Monad m => (c -> c) -> TracerT c m ()

例えば、ある関数fの呼び出し回数を記録したい場合 update succ :: TracerT Int m ()fの呼び出し時に実行すれば良い。

zoomはログの文脈を変えるアクションだ

zoom :: ASetter' c c' -> TracerT c' m a -> TracerT c m a

これはc'のログを操作するプログラムを受け取り、cのログを操作するプログラムに変換する。 これだけだとよくわからないと思うので次の例を見て欲しい。

{-# LANGUAGE TypeFamilies, DataKinds, OverloadedLabels #-}
import Data.PolyDict
import Control.Monad.CTrace
import Lens.Micro
import Control.Monad

data Main
data Sub

type instance Assoc Main "sub" = Dict Sub
type instance Assoc Sub  "count" = Int

subFunc :: Monad m => Int -> TracerT (Dict Sub) m ()
subFunc n = replicateM_ n (update (access' #count 0 %~ succ))

mainFunc :: Monad m => TracerT (Dict Main) m ()
mainFunc = zoom (access' #sub empty) (subFunc 42)

main :: IO ()
main = do
    (_,d) <- ioTracerT empty mainFunc
    print d

このプログラムではsubFuncDict Subにログを保存する計算を行い、mainFuncDict Mainにログを保存する計算を行う。mainFuncからはsubFuncを呼び出すわけであるが、そのままでは保存するログが異なるのでうまく呼び出せない。

そのために登場するのがzoomである。zoom関数はsubFuncのログをDict Mainのどこに保存すればいいかを指定している。この例では、"sub"フィールドに保存するように指定している。このようにして文脈の違いに対応することで木構造のログを生成することが可能になる。

このプログラムを実行すると

{"sub": {"count": 42}}

と表示される。mainFuncからsubFuncが呼び出されたことをログの中に表現できている。