Refactoring World, etc. and fix #387

Language/Haskell/GhcMod/CabalConfig.hs

@@ -6,17 +6,15 @@ module Language.Haskell.GhcMod.CabalConfig (
     CabalConfig
   , cabalConfigDependencies
   , cabalConfigFlags
-  , setupConfigFile
-  , World
-  , getCurrentWorld
-  , isWorldChanged
   ) where
 
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Read
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
+import Language.Haskell.GhcMod.World
 
 import qualified Language.Haskell.GhcMod.Cabal16 as C16
 import qualified Language.Haskell.GhcMod.Cabal18 as C18
@@ -27,32 +25,19 @@ import qualified Language.Haskell.GhcMod.Cabal21 as C21
 #endif
 
 import Control.Applicative ((<$>))
-import Control.Monad (unless, void, mplus)
+import Control.Monad (void, mplus, when)
 #if MIN_VERSION_mtl(2,2,1)
 import Control.Monad.Except ()
 #else
 import Control.Monad.Error ()
 #endif
-import Data.Maybe ()
-import Data.Set ()
 import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
 import Distribution.Package (InstalledPackageId(..)
                            , PackageIdentifier(..)
                            , PackageName(..))
 import Distribution.PackageDescription (FlagAssignment)
-import Distribution.Simple.BuildPaths (defaultDistPref)
-import Distribution.Simple.Configure (localBuildInfoFile)
 import Distribution.Simple.LocalBuildInfo (ComponentName)
-import Data.Traversable (traverse)
 import MonadUtils (liftIO)
-import System.Directory (doesFileExist, getModificationTime)
-import System.FilePath ((</>))
-
-#if __GLASGOW_HASKELL__ <= 704
-import System.Time (ClockTime)
-#else
-import Data.Time (UTCTime)
-#endif
 
 ----------------------------------------------------------------
 
@@ -66,9 +51,8 @@ getConfig :: (IOish m, MonadError GhcModError m)
           => Cradle
           -> m CabalConfig
 getConfig cradle = do
-    world <- liftIO $ getCurrentWorld cradle
-    let valid = isSetupConfigValid world
-    unless valid configure
+    outOfDate <- liftIO $ isSetupConfigOutOfDate cradle
+    when outOfDate configure
     liftIO (readFile file) `tryFix` \_ ->
         configure `modifyError'` GMECabalConfigure
  where
@@ -78,14 +62,6 @@ getConfig cradle = do
    configure :: (IOish m, MonadError GhcModError m) => m ()
    configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
 
-
-setupConfigFile :: Cradle -> FilePath
-setupConfigFile crdl = cradleRootDir crdl </> setupConfigPath
-
--- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
-setupConfigPath :: FilePath
-setupConfigPath = localBuildInfoFile defaultDistPref
-
 -- | Get list of 'Package's needed by all components of the current package
 cabalConfigDependencies :: (IOish m, MonadError GhcModError m)
                         => Cradle
@@ -193,57 +169,3 @@ extractField config field =
     case extractParens <$> find (field `isPrefixOf`) (tails config) of
         Just f -> Right f
         Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` config)
-
-----------------------------------------------------------------
-
-#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 -> IO World
-getCurrentWorld crdl = do
-    cachePath <- getPackageCachePath crdl
-    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 -> IO Bool
-isWorldChanged world crdl = do
-    world' <- getCurrentWorld crdl
-    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

Language/Haskell/GhcMod/Cradle.hs

@@ -5,16 +5,14 @@ module Language.Haskell.GhcMod.Cradle (
   , cleanupCradle
   ) where
 
-import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Types
 
-import Control.Applicative ((<$>))
-import qualified Control.Exception as E
 import Control.Exception.IOChoice ((||>))
-import Control.Monad (filterM)
-import Data.List (isSuffixOf)
-import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive)
-import System.FilePath ((</>),takeDirectory,pathSeparators,splitDrive)
+import System.Directory (getCurrentDirectory, removeDirectoryRecursive,
+                         getTemporaryDirectory)
+import System.FilePath (takeDirectory,pathSeparators,splitDrive)
 import System.IO.Temp
 
 
@@ -44,25 +42,26 @@ cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
 
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do
-    (rdir,cfile) <- cabalDir wdir
-    pkgDbStack <- getPackageDbStack rdir
-    tmpDir <- newTempDir rdir
+    Just cabalFile <- findCabalFiles wdir
+    let cabalDir = takeDirectory cabalFile
+    pkgDbStack <- getPackageDbStack cabalDir
+    tmpDir <- newTempDir cabalDir
     return Cradle {
         cradleCurrentDir = wdir
-      , cradleRootDir    = rdir
+      , cradleRootDir    = cabalDir
       , cradleTempDir    = tmpDir
-      , cradleCabalFile  = Just cfile
+      , cradleCabalFile  = Just cabalFile
       , cradlePkgDbStack = pkgDbStack
       }
 
 sandboxCradle :: FilePath -> IO Cradle
 sandboxCradle wdir = do
-    rdir <- getSandboxDir wdir
-    pkgDbStack <- getPackageDbStack rdir
-    tmpDir <- newTempDir rdir
+    Just sbDir <- getSandboxDb wdir
+    pkgDbStack <- getPackageDbStack sbDir
+    tmpDir <- newTempDir sbDir
     return Cradle {
         cradleCurrentDir = wdir
-      , cradleRootDir    = rdir
+      , cradleRootDir    = sbDir
       , cradleTempDir    = tmpDir
       , cradleCabalFile  = Nothing
       , cradlePkgDbStack = pkgDbStack
@@ -84,48 +83,3 @@ findCradleWithoutSandbox :: IO Cradle
 findCradleWithoutSandbox = do
     cradle <- findCradle
     return cradle { cradlePkgDbStack = [GlobalDb]} -- FIXME
-
-----------------------------------------------------------------
-
-cabalSuffix :: String
-cabalSuffix = ".cabal"
-
-cabalSuffixLength :: Int
-cabalSuffixLength = length cabalSuffix
-
--- Finding a Cabal file up to the root directory
--- Input: a directly to investigate
--- Output: (the path to the directory containing a Cabal file
---         ,the path to the Cabal file)
-cabalDir :: FilePath -> IO (FilePath,FilePath)
-cabalDir dir = do
-    cnts <- getCabalFiles dir
-    case cnts of
-        [] | dir' == dir -> E.throwIO $ userError "cabal files not found"
-           | otherwise   -> cabalDir dir'
-        cfile:_          -> return (dir,dir </> cfile)
-  where
-    dir' = takeDirectory dir
-
-getCabalFiles :: FilePath -> IO [FilePath]
-getCabalFiles dir = getFiles >>= filterM doesCabalFileExist
-  where
-    isCabal name = cabalSuffix `isSuffixOf` name
-                && length name > cabalSuffixLength
-    getFiles = filter isCabal <$> getDirectoryContents dir
-    doesCabalFileExist file = doesFileExist $ dir </> file
-
-----------------------------------------------------------------
-
-getSandboxDir :: FilePath -> IO FilePath
-getSandboxDir dir = do
-    exist <- doesFileExist sfile
-    if exist then
-        return dir
-      else if dir == dir' then
-        E.throwIO $ userError "sandbox not found"
-      else
-        getSandboxDir dir'
-  where
-    sfile = dir </> "cabal.sandbox.config"
-    dir' = takeDirectory dir

Language/Haskell/GhcMod/Error.hs

@@ -29,6 +29,9 @@ data GhcModError = GMENoMsg
                  | GMEProcess [String] GhcModError
                  -- ^ Launching an operating system process failed. The first
                  -- field is the command.
+                 | GMENoCabalFile
+                 | GMETooManyCabalFiles [FilePath]
+                 -- ^ No or too many cabal files found.
                    deriving (Eq,Show,Typeable)
 
 instance Exception GhcModError
@@ -52,6 +55,11 @@ gmeDoc e = case e of
     GMEProcess cmd msg ->
         text ("launching operating system process `"++unwords cmd++"` failed: ")
           <> gmeDoc msg
+    GMENoCabalFile ->
+        text "No cabal file found."
+    GMETooManyCabalFiles cfs ->
+        text $ "Multiple cabal files found. Possible cabal files: \""
+               ++ intercalate "\", \"" cfs ++"\"."
 
 modifyError :: MonadError e m => (e -> e) -> m a -> m a
 modifyError f action = action `catchError` \e -> throwError $ f e

Language/Haskell/GhcMod/Find.hs

@@ -22,10 +22,10 @@ import Data.List (groupBy, sort)
 import Data.Maybe (fromMaybe)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
-import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
+import Language.Haskell.GhcMod.PathsAndFiles
 import Name (getOccString)
 import System.Directory (doesFileExist, getModificationTime)
 import System.FilePath ((</>), takeDirectory)
@@ -89,7 +89,7 @@ lookupSym sym db = fromMaybe [] $ M.lookup sym $ table db
 loadSymbolDb :: IOish m => GhcModT m SymbolDb
 loadSymbolDb = do
     ghcMod <- liftIO ghcModExecutable
-    tmpdir <- liftIO . getPackageCachePath =<< cradle
+    tmpdir <- cradleTempDir <$> cradle
     file <- chop <$> readProcess' ghcMod ["dumpsym", tmpdir]
     !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
     return $ SymbolDb {

Language/Haskell/GhcMod/GhcPkg.hs

@@ -6,63 +6,34 @@ module Language.Haskell.GhcMod.GhcPkg (
   , ghcDbOpt
   , fromInstalledPackageId
   , fromInstalledPackageId'
-  , getSandboxDb
   , getPackageDbStack
-  , getPackageCachePath
-  , packageCache
-  , packageConfDir
+  , getPackageCachePaths
   ) where
 
 import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt)
 import Control.Applicative ((<$>))
-import Control.Exception (SomeException(..))
-import Control.Monad
-import qualified Control.Exception as E
-import Data.Char (isSpace)
-import Data.List (isPrefixOf, intercalate)
+import Data.List (intercalate)
 import Data.List.Split (splitOn)
 import Data.Maybe
 import Distribution.Package (InstalledPackageId(..))
 import Exception (handleIO)
+import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Utils
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory)
 import System.FilePath ((</>))
-import qualified Data.Traversable as T
 
 ghcVersion :: Int
 ghcVersion = read cProjectVersionInt
 
--- | Get path to sandbox package db
-getSandboxDb :: FilePath -- ^ Path to the cabal package root directory
-                         -- (containing the @cabal.sandbox.config@ file)
-             -> IO FilePath
-getSandboxDb cdir = getSandboxDbDir (cdir </> "cabal.sandbox.config")
-
--- | Extract the sandbox package db directory from the cabal.sandbox.config file.
---   Exception is thrown if the sandbox config file is broken.
-getSandboxDbDir :: FilePath -- ^ Path to the @cabal.sandbox.config@ file
-                -> IO FilePath
-getSandboxDbDir sconf = do
-    -- Be strict to ensure that an error can be caught.
-    !path <- extractValue . parse <$> readFile sconf
-    return path
-  where
-    key = "package-db:"
-    keyLen = length key
-
-    parse = head . filter (key `isPrefixOf`) . lines
-    extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
-
-----------------------------------------------------------------
-
 getPackageDbStack :: FilePath -- ^ Project Directory (where the
                                  -- cabal.sandbox.config file would be if it
                                  -- exists)
                   -> IO [GhcPkgDb]
-getPackageDbStack cdir =
-    (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
-      `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
+getPackageDbStack cdir = do
+    mSDir <- getSandboxDb cdir
+    return $ [GlobalDb] ++ case mSDir of
+                             Nothing -> [UserDb]
+                             Just db -> [PackageDb db]
 
 ----------------------------------------------------------------
 
@@ -114,30 +85,22 @@ ghcDbOpt (PackageDb pkgDb)
 
 ----------------------------------------------------------------
 
-packageCache :: String
-packageCache = "package.cache"
 
-packageConfDir :: String
-packageConfDir = "package.conf.d"
+getPackageCachePaths :: FilePath -> Cradle -> IO [FilePath]
+getPackageCachePaths sysPkgCfg crdl =
+    catMaybes <$> resolvePackageConfig sysPkgCfg `mapM` cradlePkgDbStack crdl
 
-getPackageCachePath :: Cradle -> IO FilePath
-getPackageCachePath crdl = do
-    let mu = listToMaybe $ filter (/= GlobalDb) $ cradlePkgDbStack crdl
-    mdb <- join <$> resolvePath `T.traverse` mu
-    let dir = case mdb of
-               Just db -> db
-               Nothing -> cradleTempDir crdl
-    return dir
 
+-- TODO: use PkgConfRef
 --- Copied from ghc module `Packages' unfortunately it's not exported :/
-resolvePath :: GhcPkgDb -> IO (Maybe FilePath)
-resolvePath (PackageDb name) = return $ Just name
-resolvePath UserDb           = handleIO (\_ -> return Nothing) $ do
+resolvePackageConfig :: FilePath -> GhcPkgDb -> IO (Maybe FilePath)
+resolvePackageConfig sysPkgCfg GlobalDb = return $ Just sysPkgCfg
+resolvePackageConfig _ UserDb = handleIO (\_ -> return Nothing) $ do
   appdir <- getAppUserDataDirectory "ghc"
   let dir = appdir </> (target_arch ++ '-':target_os ++ '-':cProjectVersion)
-        pkgconf = dir </> packageConfDir
+      pkgconf = dir </> "package.conf.d"
   exist <- doesDirectoryExist pkgconf
   return $ if exist then Just pkgconf else Nothing
  where
     [target_arch,_,target_os] = splitOn "-" cTargetPlatformString
-resolvePath _ = error "GlobalDb cannot be used in resolvePath"
+resolvePackageConfig _ (PackageDb name) = return $ Just name

Language/Haskell/GhcMod/Internal.hs

@@ -52,13 +52,12 @@ module Language.Haskell.GhcMod.Internal (
   -- * World
   , World
   , getCurrentWorld
-  , isWorldChanged
+  , didWorldChange
   ) where
 
 import GHC.Paths (libdir)
 
 import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.CabalConfig
 import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.GHCChoice
@@ -67,6 +66,7 @@ import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
+import Language.Haskell.GhcMod.World
 
 -- | Obtaining the directory for ghc system libraries.
 ghcLibDir :: FilePath

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -0,0 +1,108 @@
+{-# LANGUAGE BangPatterns, TupleSections #-}
+module Language.Haskell.GhcMod.PathsAndFiles where
+
+import Control.Applicative
+import Control.Monad
+import Data.List
+import Data.Char
+import Data.Maybe
+import Data.Traversable (traverse)
+import Language.Haskell.GhcMod.Types
+import System.Directory
+import System.FilePath
+
+import Language.Haskell.GhcMod.Error
+import qualified Language.Haskell.GhcMod.Utils as U
+
+import Distribution.Simple.BuildPaths (defaultDistPref)
+import Distribution.Simple.Configure (localBuildInfoFile)
+
+-- | Guaranteed to be a path to a directory with no trailing slash.
+type DirPath = FilePath
+
+-- | Guaranteed to be the name of a file only (no slashes).
+type FileName = String
+
+-- | @findCabalFiles dir@. Searches for a @.cabal@ files in @dir@'s parent
+-- directories. The first parent directory containing more than one cabal file
+-- is assumed to be the project directory. If only one cabal file exists in this
+-- directory it is returned otherwise @findCabalFiles@ throws 'GMENoCabalFile'
+-- or 'GMETooManyCabalFiles'
+findCabalFiles :: FilePath -> IO (Maybe FilePath)
+findCabalFiles directory = do
+    -- Look for cabal files in all parent directories of @dir@
+    dcs <- getCabalFiles `zipMapM` parents directory
+    -- Extract first non-empty list, which represents a directory with cabal
+    -- files.
+    case find (not . null) $ uncurry makeAbsolute `map` dcs of
+      Just []          -> throw $ GMENoCabalFile
+      Just cfs@(_:_:_) -> throw $ GMETooManyCabalFiles cfs
+      a  -> return $ head <$> a
+
+-- | @getCabalFiles dir@. Find all files ending in @.cabal@ in @dir@.
+getCabalFiles :: DirPath -> IO [FileName]
+getCabalFiles dir =
+    filter ((==) ".cabal" . takeExtension) <$> getDirectoryContents dir
+
+makeAbsolute :: DirPath -> [FileName] -> [FilePath]
+makeAbsolute dir fs = (dir </>) `map` fs
+
+zipMapM :: Monad m => (a -> m c) -> [a] -> m [(a,c)]
+zipMapM f as = mapM (\a -> liftM (a,) $ f a) as
+
+-- | @parents dir@. Returns all parent directories of @dir@ including @dir@.
+--
+-- Examples
+--
+-- >>> parents "foo"
+-- ["foo"]
+--
+-- >>> parents "/foo"
+-- ["/foo","/"]
+--
+-- >>> parents "/foo/bar"
+-- ["/foo/bar","/foo","/"]
+--
+-- >>> parents "foo/bar"
+-- ["foo/bar","foo"]
+parents :: FilePath -> [FilePath]
+parents "" = []
+parents dir' =
+    let (drive, dir) = splitDrive $ normalise $ dropTrailingPathSeparator dir'
+    in map (joinDrive drive) $ parents' $ filter (/=".") $ splitDirectories dir
+ where
+   parents' :: [String] -> [FilePath]
+   parents' [] | isAbsolute dir' = "":[]
+   parents' [] = []
+   parents' dir = [joinPath dir] ++ parents' (init dir)
+
+----------------------------------------------------------------
+
+-- | Get path to sandbox config file
+getSandboxDb :: FilePath -- ^ Path to the cabal package root directory
+                         -- (containing the @cabal.sandbox.config@ file)
+             -> IO (Maybe FilePath)
+getSandboxDb d = do
+  mConf <- traverse readFile =<< U.mightExist (d </> "cabal.sandbox.config")
+  return $ extractSandboxDbDir =<< mConf
+
+-- | Extract the sandbox package db directory from the cabal.sandbox.config file.
+--   Exception is thrown if the sandbox config file is broken.
+extractSandboxDbDir :: String -> Maybe FilePath
+extractSandboxDbDir conf = extractValue <$> parse conf
+  where
+    key = "package-db:"
+    keyLen = length key
+
+    parse = listToMaybe . filter (key `isPrefixOf`) . lines
+    extractValue = U.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
+
+setupConfigFile :: Cradle -> FilePath
+setupConfigFile crdl = cradleRootDir crdl </> setupConfigPath
+
+-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
+setupConfigPath :: FilePath
+setupConfigPath = localBuildInfoFile defaultDistPref
+
+packageCache :: String
+packageCache = "package.cache"

Language/Haskell/GhcMod/Utils.hs

@@ -3,7 +3,7 @@ module Language.Haskell.GhcMod.Utils where
 
 import Language.Haskell.GhcMod.Error
 import MonadUtils (MonadIO, liftIO)
-import System.Directory (getCurrentDirectory, setCurrentDirectory)
+import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist)
 import System.Exit (ExitCode(..))
 import System.Process (readProcessWithExitCode)
 #ifndef SPEC
@@ -48,6 +48,11 @@ withDirectory_ dir action =
     gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
                 (\_ -> liftIO (setCurrentDirectory dir) >> action)
 
+mightExist :: FilePath -> IO (Maybe FilePath)
+mightExist f = do
+  exists <- doesFileExist f
+  return $ if exists then (Just f) else (Nothing)
+
 -- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
 -- this is a guess but >=7.6 uses 'getExecutablePath'.
 ghcModExecutable :: IO FilePath

Language/Haskell/GhcMod/World.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE CPP #-}
+module Language.Haskell.GhcMod.World where
+{-(
+  , World
+  , getCurrentWorld
+  , isWorldChanged
+  ) where
+-}
+
+import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
+
+import Control.Applicative (pure,(<$>),(<*>))
+import Data.Maybe
+import Data.Traversable (traverse)
+import System.Directory (getModificationTime)
+import System.FilePath ((</>))
+
+import GHC.Paths (libdir)
+
+#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 TimedFile = TimedFile FilePath ModTime deriving (Eq, Show)
+
+instance Ord TimedFile where
+    compare (TimedFile _ a) (TimedFile _ b) = compare a b
+
+timeFile :: FilePath -> IO TimedFile
+timeFile f = TimedFile <$> pure f <*> getModificationTime f
+
+data World = World {
+    worldPackageCaches :: [TimedFile]
+  , worldCabalFile     :: Maybe TimedFile
+  , worldCabalConfig   :: Maybe TimedFile
+  } deriving (Eq, Show)
+
+timedPackageCache :: Cradle -> IO [TimedFile]
+timedPackageCache crdl = do
+    fs <- mapM mightExist . map (</> packageCache)
+            =<< getPackageCachePaths libdir crdl
+    timeFile `mapM` catMaybes fs
+
+getCurrentWorld :: Cradle -> IO World
+getCurrentWorld crdl = do
+    pkgCaches    <- timedPackageCache crdl
+    mCabalFile   <- timeFile `traverse` cradleCabalFile crdl
+    mSetupConfig <- mightExist (setupConfigFile crdl)
+    mCabalConfig <- timeFile `traverse` mSetupConfig
+
+    return World {
+        worldPackageCaches = pkgCaches
+      , worldCabalFile     = mCabalFile
+      , worldCabalConfig   = mCabalConfig
+      }
+
+didWorldChange :: World -> Cradle -> IO Bool
+didWorldChange world crdl = do
+    (world /=) <$> getCurrentWorld crdl
+
+-- * Neither file exists -> should return False:
+--   @Nothing < Nothing = False@
+--   (since we don't need to @cabal configure@ when no cabal file exists.)
+--
+-- * Cabal file doesn't exist (unlikely case) -> should return False
+--   @Just cc < Nothing = False@
+--   TODO: should we delete dist/setup-config?
+--
+-- * dist/setup-config doesn't exist yet -> should return True:
+--   @Nothing < Just cf = True@
+--
+-- * Both files exist
+--   @Just cc < Just cf = cc < cf = cc `olderThan` cf@
+isSetupConfigOutOfDate :: Cradle -> IO Bool
+isSetupConfigOutOfDate crdl = do
+  world <- getCurrentWorld crdl
+  return $ worldCabalConfig world < worldCabalFile world

ghc-mod.cabal

@@ -88,12 +88,14 @@ Library
                         Language.Haskell.GhcMod.Logger
                         Language.Haskell.GhcMod.Modules
                         Language.Haskell.GhcMod.Monad
+                        Language.Haskell.GhcMod.PathsAndFiles
                         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
@@ -187,18 +189,18 @@ Test-Suite spec
   Hs-Source-Dirs:       test, .
   Ghc-Options:          -Wall
   Type:                 exitcode-stdio-1.0
-  Other-Modules:        Dir
-                        Spec
-                        BrowseSpec
+  Other-Modules:        BrowseSpec
                         CabalApiSpec
                         CheckSpec
+                        Dir
                         FlagSpec
                         InfoSpec
                         LangSpec
                         LintSpec
                         ListSpec
                         MonadSpec
-                        GhcPkgSpec
+                        PathsAndFilesSpec
+                        Spec
                         TestUtils
   Build-Depends:        base >= 4.0 && < 5
                       , containers

src/GHCMod.hs

@@ -442,7 +442,7 @@ legacyInteractiveLoop symdbreq ref world = do
 
     -- after blocking, we need to see if the world has changed.
 
-    changed <- liftIO . isWorldChanged world =<< cradle
+    changed <- liftIO . didWorldChange world =<< cradle
     when changed $ do
         liftIO $ ungetCommand ref cmdArg
         throw Restart

src/GHCModi.hs

@@ -134,7 +134,7 @@ loop symdbreq ref world = do
     cmdArg <- liftIO $ getCommand ref
     -- after blocking, we need to see if the world has changed.
     crdl <- cradle
-    changed <- liftIO $ isWorldChanged world crdl
+    changed <- liftIO $ didWorldChange world crdl
     when changed $ do
         liftIO $ ungetCommand ref cmdArg
         E.throw Restart

test/PathsAndFilesSpec.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE CPP #-}
-module GhcPkgSpec where
+module PathsAndFilesSpec where
 
-import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.PathsAndFiles
 #if __GLASGOW_HASKELL__ <= 706
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.GhcPkg
 #endif
 
 import System.Directory
@@ -23,7 +24,7 @@ spec = do
         it "can parse a config file and extract the sandbox package-db" $ do
             cwd <- getCurrentDirectory
             pkgDb <- getSandboxDb "test/data/"
-            pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
+            pkgDb `shouldBe` Just (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
 
-        it "throws an error if the sandbox config file is broken" $ do
-            getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException
+        it "returns Nothing if the sandbox config file is broken" $ do
+            getSandboxDb "test/data/broken-sandbox" `shouldReturn` Nothing