haskell - 让模板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]

locatedError生产定制 error功能，给定位置。 withLocatedError将此提供给 fromJust'将所有东西连接在一起。 formatLoc只需将位置很好地格式化为字符串。

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

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