From 8b8f947b5ea05d53cbed1f1594c82041da065d26 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Wed, 29 Apr 2015 18:44:21 +0200
Subject: [PATCH] Reinitialize GHC session when options change

---
 Language/Haskell/GhcMod/Target.hs | 49 +++++++++++++++----------------
 1 file changed, 24 insertions(+), 25 deletions(-)

diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs
index fb20c97..790a581 100644
--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@@ -92,34 +92,33 @@ initSession :: IOish m
 initSession opts mdf = do
    s <- gmsGet
    case gmGhcSession s of
-     Just GmGhcSession {..} -> do
-         if gmgsOptions == opts
-            then return ()
-            else error "TODO: reload stuff"
-     Nothing -> do
-       Cradle { cradleTempDir } <- cradle
-       ghc <- liftIO $ runGhc (Just libdir) $ do
-           let setDf df =
-                setTmpDir cradleTempDir <$> (mdf =<< addCmdOpts opts df)
-           _ <- setSessionDynFlags =<< setDf =<< getSessionDynFlags
-           getSession
+     Just GmGhcSession {..} -> when (gmgsOptions /= opts) $ putNewSession s
+     Nothing -> putNewSession s
 
-       rghc <- liftIO $ newIORef ghc
-       gmsPut s { gmGhcSession = Just $ GmGhcSession opts rghc }
+ where
+   putNewSession s = do
+     rghc <- (liftIO . newIORef =<< newSession =<< cradle)
+     gmsPut s { gmGhcSession = Just $ GmGhcSession opts rghc }
+
+   newSession Cradle { cradleTempDir } = liftIO $ do
+     runGhc (Just libdir) $ do
+       let setDf df = setTmpDir cradleTempDir <$> (mdf =<< addCmdOpts opts df)
+       _ <- setSessionDynFlags =<< setDf =<< getSessionDynFlags
+       getSession
+
+dropSession :: IOish m => GhcModT m ()
+dropSession = do
+  s <- gmsGet
+  case gmGhcSession s of
+    Just (GmGhcSession _opts ref) -> do
+      -- TODO: This is still not enough, there seem to still be references to
+      -- GHC's state around afterwards.
+      liftIO $ writeIORef ref (error "HscEnv: session was dropped")
+      liftIO $ setUnsafeGlobalDynFlags (error "DynFlags: session was dropped")
 
 
--- $ do
---         dflags <- getSessionDynFlags
---         defaultCleanupHandler dflags $ do
---             initializeFlagsWithCradle opt (gmCradle env)
---
-
--- initSession :: GhcMonad m => Options -> [GHCOption] -> m ()
--- initSession Options {..} ghcOpts = do
---     df <- G.getSessionDynFlags
---     void $
---       ( setModeSimple -- $ setEmptyLogger
---                       df)
+    Nothing -> return ()
+  gmsPut s { gmGhcSession = Nothing }
 
 runGmlT :: IOish m => [Either FilePath ModuleName] -> GmlT m a -> GhcModT m a
 runGmlT fns action = runGmlT' fns return action