Refactoring World, etc. and fix #387

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