[Haskell-cafe] Problems with GHC API and error handling

[Daniel F]

OK, thanks to Luite Stegeman I've found the solution and I think I'll
post it here in case someone else stumbles upon the same problem.

The solution is the following: you have to change 'log_action'
parameter in dynFlags. For example, one can do this:

-----------------------------------------------------------------------------------------------------------------------
initGhc = do
  ..
  ref <- liftIO $ newIORef ""
  dfs <- getSessionDynFlags
  setSessionDynFlags $ dfs { hscTarget = HscInterpreted
                           , ghcLink = LinkInMemory
                           , log_action = logHandler ref}

logHandler :: IORef String -> LogAction
logHandler ref dflags severity srcSpan style msg =
  case severity of
     SevError ->   modifyIORef' ref (++ printDoc)
     SevFatal ->   modifyIORef' ref (++ printDoc)
     _ -> return ()
  where cntx = initSDocContext dflags style
         locMsg = mkLocMessage severity srcSpan msg
         printDoc = show (runSDoc locMsg cntx)

-- LogAction == DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()

-----------------------------------------------------------------------------------------------------------------------
On Sat, Jun 15, 2013 at 1:26 PM, Daniel F <difrumin at gmail.com> wrote:
> Hello, everyone.
>
> I am in need of setting up custom exception handlers when using GHC
> API to compile modules. Right now I have the following piece of code:
>
> * Main.hs:
> --------------------------------------------------------------------------------------------------
> import GHC
> import GHC.Paths
> import MonadUtils
> import Exception
> import Panic
> import Unsafe.Coerce
> import System.IO.Unsafe
>
>
> handleException :: (ExceptionMonad m, MonadIO m)
>                    => m a -> m (Either String a)
> handleException m =
>   ghandle (\(ex :: SomeException) -> return (Left (show ex))) $
>   handleGhcException (\ge -> return (Left (showGhcException ge ""))) $
>   flip gfinally (liftIO restoreHandlers) $
>   m >>= return . Right
>
>
> initGhc :: Ghc ()
> initGhc = do
>   dfs <- getSessionDynFlags
>   setSessionDynFlags $ dfs { hscTarget = HscInterpreted
>                            , ghcLink = LinkInMemory }
>   return ()
>
> test :: IO (Either String Int)
> test = handleException $ runGhc (Just libdir) $ do
>   initGhc
>   setTargets =<< sequence [ guessTarget "./test/file1.hs" Nothing ]
>   graph <- depanal [] False
>   loaded <- load LoadAllTargets
>   -- when (failed loaded) $ throw LoadingException
>   setContext (map (IIModule . moduleName . ms_mod) graph)
>   let expr = "main"
>   ty <- exprType expr -- throws exception if doesn't typecheck
>   output ty
>   res <- unsafePerformIO . unsafeCoerce <$> compileExpr expr
>   return res
>
> --------------------------------------------------------------------------------------------------
>
> * file1.hs:
>
> ----------------------------
> module Main where
>
> main = do
>   return x
>
> ----------------------------
>
> The problem is when I run the 'test' function above I receive the
> following output:
>
> h> test
>
> test/file1.hs:4:10: Not in scope: `x'
>
> Left "Cannot add module Main to context: not a home module"
> it :: Either String Int
>
>
> So, if I understand this correctly, my exception handler does indeed
> catch an exception correctly,
> however, I still receive some output which I want to be captured.
> Is there a way to do this?
>
> --
> Sincerely yours,
> -- Daniil Frumin



-- 
Sincerely yours,
-- Daniil