使用模板haskell包装带有源信息的函数(例如行号)的正确方法是什么

Question

假设我从一个函数开始

fromJust Nothing = error "fromJust got Nothing!"
fromJust (Just x) = x

然后,我想通过Template Haskell添加源信息以获得更好的错误消息.让我们想象一下,我可以在函数中添加一个额外的参数

fromJust' loc Nothing = error $ "fromJust got Nothing at " ++ (loc_filename loc)
fromJust' loc (Just x) = x

然后有一些fromJust我可以在源代码中使用的宏,比如

x = $fromJust $ Map.lookup k m

劈

我确实设法通过使用quasiquotes并提取源文件名的字符串来破解它.似乎Loc没有Lift实例.有没有更好的办法？

fromJustErr' l (Nothing) =
    error $ printf "[internal] fromJust error\
        \\n    (in file %s)" l
fromJustErr' l (Just x) = x
fromJustErr = do
    l <- location
    let fn = loc_filename l
        fnl :: Q Exp = TH.lift fn
    [| fromJustErr' $fnl |]

谢谢!

(我知道fmap通过Maybe仿函数比使用更好fromJust,但我有时需要破解.)

Answer 1

这是使该模式更具可重用性的尝试。

关键思想是将自定义传递error给我们的函数，其中将包含错误消息中的位置。你会像这样使用它：

fromJust' :: (String -> a) -> Maybe a -> a
fromJust' error Nothing = error "fromJust got Nothing!"
fromJust' error (Just x) = x

fromJust :: Q Exp
fromJust = withLocatedError [| fromJust' |]

使用此函数与您原来的方法类似：

main = print (1 + $fromJust Nothing)

现在，对于使这项工作有效的 Haskell 模板：

withLocatedError :: Q Exp -> Q Exp
withLocatedError f = do
    let error = locatedError =<< location
    appE f error

locatedError :: Loc -> Q Exp
locatedError loc = do
    let postfix = " at " ++ formatLoc loc
    [| \msg -> error (msg ++ $(litE $ stringL postfix)) |]

formatLoc :: Loc -> String
formatLoc loc = let file = loc_filename loc
                    (line, col) = loc_start loc
                in concat [file, ":", show line, ":", show col]

locatedErrorerror在给定位置的情况下生成定制函数。withLocatedError将其提供给fromJust'将所有内容连接在一起。formatLoc只需将位置很好地格式化为字符串即可。

运行这个给我们我们想要的结果：

FromJustTest: fromJust got Nothing! at FromJustTest.hs:5:19