Haskellのassertで条件式をエラーメッセージに含める

モチベーション

Control.Exception.assertで、以下のように実行すると、ちゃんと失敗します。

let a = "hello"
assert (length a == 999) 123
*** Exception: <interactive>:9:1-6: Assertion failed

Haskell以外の言語の中には、条件式length a == 999をランタイムエラーのメッセージに含めてくれるで、Haskellにそれ相当のものを探してみました、見当たりませんでした。

他の方も同じことを考えて、探されたようですが、見つからなかったということです。

プログラミング言語によっては、 assert 対象の式を文字列化してエラーメッセージに加えてくれるものがありますが、 Haskell の assert 関数は、関数である以上、そういう特殊なことはできません。（Template Haskell を使えば可能かもしれませんが、そういうライブラリーは軽くググった感じでは見当たりませんでした）

(引用：　Haskell でのデバッグ手法あれこれ | 雑記帳)

なので、見つかるまでの間に使うために、TemplateHaskellを使って条件式をエラーメッセージに出力するassertを作ります。

見た目

以下がユーザーからの見た目です。

  let a = "hello"
  let b = 10
  let !x = [assert|a == "hello" && b > 9999999|]

言語拡張QuasiQuotesを有効にして使うようにしました。

エラーは、以下のようになり、条件式がちゃんと表示されるようになってます。

ExampleMain.hs: Assertion failed: 'a == "hello" && b > 9999999'
CallStack (from HasCallStack):
  error, called at examples/ExampleMain.hs:9:20 in main:Main

コード

{-# LANGUAGE TemplateHaskell #-}

module Assertion where

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Quote as TH.Quote
import qualified Language.Haskell.Meta as Haskell.Meta

-- | Assert
assert :: TH.Quote.QuasiQuoter
assert = TH.Quote.QuasiQuoter
         { TH.Quote.quoteExp = \condStr -> do
             let Right condExp = Haskell.Meta.parseExp condStr
             [|if $(return condExp)
                then ()
                else error ("Assertion failed: '" ++ condStr ++ "'")|]
         , TH.Quote.quotePat  = undefined
         , TH.Quote.quoteType = undefined
         , TH.Quote.quoteDec  = undefined
         }

a == "hello" && b > 9999999のような条件式は、文字列condStrとして、渡ってくるので、それをエラーメッセージそのまま埋め込むようにExpQを構築しています。

Haskell.Meta.parseExpでは文字列をパースしてExpを取得しています。

リポジトリ

今回のコードは、以下のリポジトリにおいてあります。

nwtgck/assertion-haskell

Stackを使っている場合は、以下のextra-depsをstack.yamlに加えて、

...
extra-deps:
- git: https://github.com/nwtgck/assertion-haskell.git
  commit: 4340a96555606d590d54669b9ae992a5b8c9a10d
...

package.yamlに以下ようにassertionを適切なdependenciesに加えれば、今回の[assert|...|]が使えるようになります。

...
library:
 dependencies:
 - assertion
...

おまけ: static assert

以下のリポジトリには、コンパイル時にassertするstaticAssertもおまけで、入れてあります。コンパイル時に判断できるassertは実行時まで引き伸ばしたくありませんよね。

-- ちゃんとコンパイルエラーになる！
let _ = $(staticAssert (length "hello" == 99999))