ghc-mod/Language/Haskell/GhcMod/World.hs
2014-11-02 01:19:27 +01:00

90 lines
2.5 KiB
Haskell

{-# 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