Uses HscNothing and falls back to HscInterpreted if necessary (#205)

Two Test case are fails but it is not fatal.

Language/Haskell/GhcMod/Check.hs

@@ -34,8 +34,7 @@ check :: IOish m
       => [FilePath]  -- ^ The target files.
       -> GhcModT m (Either String String)
 check fileNames = do
-  withLogger setAllWaringFlags $ do
-    setTargetFiles fileNames
+  withLogger setAllWaringFlags $ setTargetFiles fileNames
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/DynFlags.hs

@@ -4,11 +4,12 @@ import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
-import Control.Monad (forM, void)
+import Control.Monad (forM, void, (>=>))
 import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
 import GhcMonad
 import GHC.Paths (libdir)
+import DynFlags (ExtensionFlag(..), xopt)
 
 import System.IO.Unsafe (unsafePerformIO)
 
@@ -17,11 +18,23 @@ data Build = CabalPkg | SingleFile deriving Eq
 setEmptyLogger :: DynFlags -> DynFlags
 setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
 
--- we don't want to generate object code so we compile to bytecode
--- (HscInterpreted) which implies LinkInMemory
--- HscInterpreted
-setLinkerOptions :: DynFlags -> DynFlags
-setLinkerOptions df = df {
+-- Fast
+-- Friendly to foreign export
+-- Not friendly to Template Haskell
+-- Uses small memory
+setModeSimple :: DynFlags -> DynFlags
+setModeSimple df = df {
+    ghcMode   = CompManager
+  , ghcLink   = NoLink
+  , hscTarget = HscNothing
+  }
+
+-- Slow
+-- Not friendly to foreign export
+-- Friendly to Template Haskell
+-- Uses large memory
+setModeIntelligent :: DynFlags -> DynFlags
+setModeIntelligent df = df {
     ghcMode   = CompManager
   , ghcLink   = LinkInMemory
   , hscTarget = HscInterpreted
@@ -59,7 +72,28 @@ setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
 setTargetFiles files = do
     targets <- forM files $ \file -> G.guessTarget file Nothing
     G.setTargets targets
+    xs <- G.depanal [] False
+    -- FIXME, checking state
+    loadTargets $ needsFallback xs
+  where
+    loadTargets False = do
+        -- Reporting error A and error B
         void $ G.load LoadAllTargets
+        mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
+        -- Reporting error B and error C
+        mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
+        -- Error B duplicates. But we cannot ignore both error reportings,
+        -- sigh. So, the logger makes log messages unique by itself.
+    loadTargets True = do
+        df <- G.getSessionDynFlags
+        void $ G.setSessionDynFlags (setModeIntelligent df)
+        void $ G.load LoadAllTargets
+
+needsFallback :: G.ModuleGraph -> Bool
+needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
+  where
+    hasTHorQQ :: DynFlags -> Bool
+    hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/Logger.hs

@@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.Logger (
   ) where
 
 import Bag (Bag, bagToList)
-import Control.Applicative ((<$>),(*>))
+import Control.Applicative ((<$>))
 import CoreMonad (liftIO)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import Data.List (isPrefixOf)
@@ -28,21 +28,29 @@ import System.FilePath (normalise)
 
 type Builder = [String] -> [String]
 
-newtype LogRef = LogRef (IORef Builder)
+data Log = Log [String] Builder
+
+newtype LogRef = LogRef (IORef Log)
+
+emptyLog :: Log
+emptyLog = Log [] id
 
 newLogRef :: IO LogRef
-newLogRef = LogRef <$> newIORef id
+newLogRef = LogRef <$> newIORef emptyLog
 
 readAndClearLogRef :: IOish m => LogRef -> GhcModT m String
 readAndClearLogRef (LogRef ref) = do
-    b <- liftIO $ readIORef ref
-    liftIO $ writeIORef ref id
+    Log _ b <- liftIO $ readIORef ref
+    liftIO $ writeIORef ref emptyLog
     convert' (b [])
 
 appendLogRef :: DynFlags -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-appendLogRef df (LogRef ref) _ sev src style msg = do
-        let !l = ppMsg src sev df style msg
-        modifyIORef ref (\b -> b . (l:))
+appendLogRef df (LogRef ref) _ sev src style msg = modifyIORef ref update
+  where
+    l = ppMsg src sev df style msg
+    update lg@(Log ls b)
+      | l `elem` ls = lg
+      | otherwise   = Log (l:ls) (b . (l:))
 
 ----------------------------------------------------------------
 
@@ -57,7 +65,9 @@ withLogger setDF body = ghandle sourceError $ do
     logref <- liftIO $ newLogRef
     wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
     withDynFlags (setLogger logref . setDF) $ do
-        withCmdFlags wflags $ do body *> (Right <$> readAndClearLogRef logref)
+        withCmdFlags wflags $ do
+            body
+            Right <$> readAndClearLogRef logref
   where
     setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
 

Language/Haskell/GhcMod/Monad.hs

@@ -189,7 +189,7 @@ initSession :: GhcMonad m
 initSession build Options {..} CompilerOptions {..} = do
     df <- G.getSessionDynFlags
     void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
-      $ setLinkerOptions
+      $ setModeSimple
       $ setIncludeDirs includeDirs
       $ setBuildEnv build
       $ setEmptyLogger