From d0a10277bf6d27516b0ada30d6bb2a3163f4c5e6 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Thu, 20 Mar 2014 17:40:06 +0900
Subject: [PATCH] make ghc-modi robust.

---
 Language/Haskell/GhcMod/GHCApi.hs   |  1 +
 Language/Haskell/GhcMod/Internal.hs |  2 ++
 src/GHCModi.hs                      | 22 +++++++++++++++++-----
 3 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index d43265b..6830671 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@@ -8,6 +8,7 @@ module Language.Haskell.GhcMod.GHCApi (
   , setTargetFiles
   , addTargetFiles
   , getDynamicFlags
+  , getSystemLibDir
   ) where
 
 import Control.Applicative
diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs
index 9908fc4..e571cb1 100644
--- a/Language/Haskell/GhcMod/Internal.hs
+++ b/Language/Haskell/GhcMod/Internal.hs
@@ -29,6 +29,8 @@ module Language.Haskell.GhcMod.Internal (
   , runAnyOne
   -- * 'GhcMonad' Choice
   , (|||>)
+  -- * GHC
+  , getSystemLibDir
   ) where
 
 import Language.Haskell.GhcMod.CabalApi
diff --git a/src/GHCModi.hs b/src/GHCModi.hs
index 8da8dde..a3a6417 100644
--- a/src/GHCModi.hs
+++ b/src/GHCModi.hs
@@ -1,26 +1,38 @@
 module Main where
 
-import System.IO
 import Control.Monad
 import CoreMonad (liftIO)
+import Data.List
 import Data.Set as S
-import Exception (ghandle)
+import Exception (ghandle, SomeException(..))
 import GHC
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Internal
+import System.IO
 
 main :: IO ()
 main = do
     cradle <- findCradle
-    void $ withGHCDummyFile $ do
+    run ls $ do
         (readLog,_) <- initializeFlagsWithCradle opt cradle ["-Wall"] True
         loop readLog ls S.empty
-        return []
-    return ()
   where
     opt = defaultOptions
     ls = lineSeparator opt
 
+run :: LineSeparator -> Ghc () -> IO ()
+run (LineSeparator ls) body = do
+    mlibdir <- getSystemLibDir
+    ghandle ignore $ runGhc mlibdir $ do
+        dflags <- getSessionDynFlags
+        defaultCleanupHandler dflags body
+  where
+    ignore (SomeException e) = do
+        putStr "ghc-modi:0:0:Error:"
+        let x = intercalate ls $ lines $ show e
+        putStrLn x
+        putStrLn "NG"
+
 loop :: IO [String] -> LineSeparator -> Set FilePath -> Ghc ()
 loop readLog ls set = do
     file <- liftIO $ getLine