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
というモナドトランスフォーマが木構造のログを可能にする。
このモナドではupdate
とzoom
という二つのアクションが実行できる。
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
このプログラムではsubFunc
がDict Sub
にログを保存する計算を行い、mainFunc
がDict Main
にログを保存する計算を行う。mainFunc
からはsubFunc
を呼び出すわけであるが、そのままでは保存するログが異なるのでうまく呼び出せない。
そのために登場するのがzoom
である。zoom
関数はsubFuncのログをDict Main
のどこに保存すればいいかを指定している。この例では、"sub"
フィールドに保存するように指定している。このようにして文脈の違いに対応することで木構造のログを生成することが可能になる。
このプログラムを実行すると
{"sub": {"count": 42}}
と表示される。mainFuncからsubFuncが呼び出されたことをログの中に表現できている。