Commit c7d55c3c authored by Duncan Coutts's avatar Duncan Coutts
Browse files

New Rebuild monad utils and use in ProjectPlanning

Monitored variants of createDirectory and getDirectoryContents.
Define thee wrappers in the RebuildMonad module so we have fewer
open-coded tricky monitorFiles calls.

In particular replace a glob monitor on the content of the store with a
monitor on the store directory itself. This is valid based on the
behaviour of directory mtimes, which is specified by posix and we have a
sanity check for it in the unit tests.
parent 5a880c07
......@@ -133,7 +133,6 @@ import Data.Either
import Data.Monoid
import Data.Function
import System.FilePath
import System.Directory (doesDirectoryExist, getDirectoryContents)
------------------------------------------------------------------------------
-- * Elaborated install plan
......@@ -606,7 +605,7 @@ rebuildInstallPlan verbosity
phaseImprovePlan elaboratedPlan elaboratedShared = do
liftIO $ debug verbosity "Improving the install plan..."
recreateDirectory verbosity True storeDirectory
createDirectoryMonitored True storeDirectory
storePkgIndex <- getPackageDBContents verbosity
compiler progdb platform
storePackageDb
......@@ -678,8 +677,7 @@ getExecutableDBContents
:: FilePath -- store directory
-> Rebuild (Set ComponentId)
getExecutableDBContents storeDirectory = do
monitorFiles [monitorFileGlob (FilePathGlob (FilePathRoot storeDirectory) (GlobFile [WildCard]))]
paths <- liftIO $ getDirectoryContents storeDirectory
paths <- getDirectoryContentsMonitored storeDirectory
return (Set.fromList (map ComponentId (filter valid paths)))
where
valid "." = False
......@@ -721,22 +719,10 @@ getPkgConfigDb verbosity progdb = do
dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb
-- Just monitor the dirs so we'll notice new .pc files.
-- Alternatively we could monitor all the .pc files too.
forM_ dirs $ \dir -> do
dirExists <- liftIO $ doesDirectoryExist dir
-- TODO: turn this into a utility function
monitorFiles [if dirExists
then monitorDirectory dir
else monitorNonExistentDirectory dir]
mapM_ monitorDirectoryStatus dirs
liftIO $ readPkgConfigDb verbosity progdb
recreateDirectory :: Verbosity -> Bool -> FilePath -> Rebuild ()
recreateDirectory verbosity createParents dir = do
liftIO $ createDirectoryIfMissingVerbose verbosity createParents dir
monitorFiles [monitorDirectoryExistence dir]
-- | Select the config values to monitor for changes package source hashes.
packageLocationsSignature :: SolverInstallPlan
-> [(PackageId, PackageLocation (Maybe FilePath))]
......
......@@ -42,6 +42,9 @@ module Distribution.Client.RebuildMonad (
-- * Utils
matchFileGlob,
getDirectoryContentsMonitored,
createDirectoryMonitored,
monitorDirectoryStatus,
) where
import Distribution.Client.FileMonitor
......@@ -58,6 +61,7 @@ import Control.Monad.State as State
import Control.Monad.Reader as Reader
import Distribution.Compat.Binary (Binary)
import System.FilePath (takeFileName)
import System.Directory
-- | A monad layered on top of 'IO' to help with re-running actions when the
......@@ -136,7 +140,7 @@ rerunIfChanged verbosity monitor key action = do
-- | Utility to match a file glob against the file system, starting from a
-- given root directory. The results are all relative to the given root.
--
-- Since this operates in the 'Rebuild' monad, it also monitrs the given glob
-- Since this operates in the 'Rebuild' monad, it also monitors the given glob
-- for changes.
--
matchFileGlob :: FilePathGlob -> Rebuild [FilePath]
......@@ -145,3 +149,22 @@ matchFileGlob glob = do
monitorFiles [monitorFileGlobExistence glob]
liftIO $ Glob.matchFileGlob root glob
getDirectoryContentsMonitored :: FilePath -> Rebuild [FilePath]
getDirectoryContentsMonitored dir = do
monitorFiles [monitorDirectory dir]
liftIO $ getDirectoryContents dir
createDirectoryMonitored :: Bool -> FilePath -> Rebuild ()
createDirectoryMonitored createParents dir = do
monitorFiles [monitorDirectoryExistence dir]
liftIO $ createDirectoryIfMissing createParents dir
-- | Monitor a directory as in 'monitorDirectory' if it currently exists or
-- as 'monitorNonExistentDirectory' if it does not.
monitorDirectoryStatus :: FilePath -> Rebuild ()
monitorDirectoryStatus dir = do
exists <- liftIO $ doesDirectoryExist dir
monitorFiles [if exists
then monitorDirectory dir
else monitorNonExistentDirectory dir]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment