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