what's the correct way to have template haskell wrap a function with source information (e.g. line number)

Question

Suppose I start with a function

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

Then, I want to add source information via Template Haskell for better error messages. Let's imagine that I could add an extra parameter to the function

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

and then have some fromJust macro that I could use in source code like,

x = $fromJust $ Map.lookup k m

hack

I did manage to hack it, by using quasiquotes and lifting the string of the source filename. It seems that Loc doesn't have a Lift instance. Is there a better way?

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 |]

Thanks!

(I know it's nicer to fmap stuff via the Maybe functor than use fromJust, but I need to hack sometimes.)

Answer 1

Here's an attempt at making this pattern somewhat more reusable.

The key idea is to pass a customized error to our function which will include the location in the error message. You'd use it like this:

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

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

Using this function is similar to your original approach:

main = print (1 + $fromJust Nothing)

Now, for the Template Haskell that makes this work:

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 produces the customized error function, given a location. withLocatedError feeds this to fromJust' to hook everything together. formatLoc just formats the location nicely into a string.

Running this gives us the result we wanted:

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