adding World.hs.

Language/Haskell/GhcMod/Internal.hs

@@ -46,9 +46,14 @@ module Language.Haskell.GhcMod.Internal (
   , (||>)
   , goNext
   , runAnyOne
+  -- * World
+  , World
+  , getWorld
+  , isChanged
   ) where
 
 import GHC.Paths (libdir)
+import GHC (getSessionDynFlags)
 
 import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.DynFlags
@@ -57,7 +62,20 @@ import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.World
 
 -- | Obtaining the directory for ghc system libraries.
 ghcLibDir :: FilePath
 ghcLibDir = libdir
+
+getWorld :: IOish m => GhcModT m World
+getWorld = do
+    crdl <- cradle
+    dflags <- getSessionDynFlags
+    liftIO $ getCurrentWorld crdl dflags
+
+isChanged :: IOish m => World -> GhcModT m Bool
+isChanged world = do
+    crdl <- cradle
+    dflags <- getSessionDynFlags
+    liftIO $ isWorldChanged world crdl dflags

Language/Haskell/GhcMod/World.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE RecordWildCards, CPP #-}
+
+module Language.Haskell.GhcMod.World (
+    World
+  , getCurrentWorld
+  , isWorldChanged
+  , isSetupConfigValid
+  ) where
+
+import Control.Applicative ((<$>))
+import Data.Traversable (traverse)
+import DynFlags (DynFlags(..))
+import Language.Haskell.GhcMod.CabalConfig
+import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.Types
+import System.Directory (doesFileExist, getModificationTime)
+import System.FilePath ((</>))
+
+#if __GLASGOW_HASKELL__ <= 704
+import System.Time (ClockTime)
+#else
+import Data.Time (UTCTime)
+#endif
+
+#if __GLASGOW_HASKELL__ <= 704
+type ModTime = ClockTime
+#else
+type ModTime = UTCTime
+#endif
+
+data World = World {
+    worldCabalFile :: Maybe FilePath
+  , worldCabalFileModificationTime :: Maybe ModTime
+  , worldPackageCache :: FilePath
+  , worldPackageCacheModificationTime :: ModTime
+  , worldSetupConfig :: FilePath
+  , worldSetupConfigModificationTime :: Maybe ModTime
+  } deriving (Show, Eq)
+
+getCurrentWorld :: Cradle -> DynFlags -> IO World
+getCurrentWorld crdl dflags = do
+    cachePath <- getPackageCachePath crdl dflags
+    let mCabalFile = cradleCabalFile crdl
+        pkgCache = cachePath </> packageCache
+        setupFile = setupConfigFile crdl
+    mCabalFileMTime <- getModificationTime `traverse` mCabalFile
+    pkgCacheMTime <- getModificationTime pkgCache
+    exist <- doesFileExist setupFile
+    mSeetupMTime <- if exist then
+                        Just <$> getModificationTime setupFile
+                      else
+                        return Nothing
+    return $ World {
+        worldCabalFile = mCabalFile
+      , worldCabalFileModificationTime = mCabalFileMTime
+      , worldPackageCache = pkgCache
+      , worldPackageCacheModificationTime = pkgCacheMTime
+      , worldSetupConfig = setupFile
+      , worldSetupConfigModificationTime = mSeetupMTime
+      }
+
+isWorldChanged :: World -> Cradle -> DynFlags -> IO Bool
+isWorldChanged world crdl dflags = do
+    world' <- getCurrentWorld crdl dflags
+    return (world /= world')
+
+isSetupConfigValid :: World -> Bool
+isSetupConfigValid World{ worldSetupConfigModificationTime = Nothing, ..} = False
+isSetupConfigValid World{ worldSetupConfigModificationTime = Just mt, ..} =
+    cond1 && cond2
+  where
+    cond1 = case worldCabalFileModificationTime of
+        Nothing -> True
+        Just mtime -> mtime <= mt
+    cond2 = worldPackageCacheModificationTime <= mt

ghc-mod.cabal

@@ -86,14 +86,15 @@ Library
                         Language.Haskell.GhcMod.Lang
                         Language.Haskell.GhcMod.Lint
                         Language.Haskell.GhcMod.Logger
-                        Language.Haskell.GhcMod.Monad
                         Language.Haskell.GhcMod.Modules
+                        Language.Haskell.GhcMod.Monad
                         Language.Haskell.GhcMod.PkgDoc
                         Language.Haskell.GhcMod.Read
                         Language.Haskell.GhcMod.SrcUtils
                         Language.Haskell.GhcMod.Target
                         Language.Haskell.GhcMod.Types
                         Language.Haskell.GhcMod.Utils
+                        Language.Haskell.GhcMod.World
   Build-Depends:        base >= 4.0 && < 5
                       , containers
                       , deepseq

src/GHCModi.hs

@@ -28,7 +28,7 @@ import Data.List (intercalate)
 import Data.List.Split (splitOn)
 import Data.Version (showVersion)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Internal (cradle)
+import Language.Haskell.GhcMod.Internal
 import Paths_ghc_mod
 import System.Console.GetOpt
 import System.Directory (setCurrentDirectory)
@@ -91,7 +91,7 @@ run opt ref = flip E.catches handlers $ do
     prepareAutogen cradle0
     -- Asynchronous db loading starts here.
     symdbreq <- newSymDbReq opt
-    (res, _) <- runGhcModT opt $ getCurrentWorld >>= loop symdbreq ref
+    (res, _) <- runGhcModT opt $ getWorld >>= loop symdbreq ref
     case res of
         Right () -> return ()
         Left (GMECabalConfigure msg) -> do
@@ -126,7 +126,7 @@ loop symdbreq ref world = do
     -- blocking
     cmdArg <- liftIO $ getCommand ref
     -- after blocking, we need to see if the world has changed.
-    changed <- isWorldChanged world
+    changed <- isChanged world
     when changed $ do
         liftIO $ ungetCommand ref cmdArg
         E.throw Restart

src/Misc.hs

@@ -3,9 +3,6 @@
 module Misc (
     GHCModiError(..)
   , Restart(..)
-  , World
-  , getCurrentWorld
-  , isWorldChanged
   , UnGetLine
   , emptyNewUnGetLine
   , ungetCommand
@@ -26,13 +23,8 @@ import CoreMonad (liftIO)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.List (isPrefixOf)
 import Data.Maybe (isJust)
-#if __GLASGOW_HASKELL__ <= 704
-import System.Time (ClockTime)
-#else
-import Data.Time (UTCTime)
-#endif
 import Data.Typeable (Typeable)
-import System.Directory (getModificationTime, doesDirectoryExist, getDirectoryContents)
+import System.Directory (doesDirectoryExist, getDirectoryContents)
 import System.IO (openBinaryFile, IOMode(..))
 import System.Process
 
@@ -53,29 +45,6 @@ instance Exception Restart
 
 ----------------------------------------------------------------
 
-data World = World {
-#if __GLASGOW_HASKELL__ <= 704
-    worldCabalFileModificationTime :: Maybe ClockTime
-#else
-    worldCabalFileModificationTime :: Maybe UTCTime
-#endif
-  } deriving (Show, Eq)
-
-getCurrentWorld :: IOish m => GhcModT m World
-getCurrentWorld = do
-    crdl <- cradle
-    mmt <- case cradleCabalFile crdl of
-        Just file -> liftIO $ Just <$> getModificationTime file
-        Nothing   -> return Nothing
-    return $ World { worldCabalFileModificationTime = mmt }
-
-isWorldChanged :: IOish m => World -> GhcModT m Bool
-isWorldChanged world = do
-    world' <- getCurrentWorld
-    return (world /= world')
-
-----------------------------------------------------------------
-
 newtype UnGetLine = UnGetLine (IORef (Maybe String))
 
 emptyNewUnGetLine :: IO UnGetLine