{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, BangPatterns #-}
module Distribution.Client.RebuildMonad (
Rebuild,
runRebuild,
execRebuild,
askRoot,
monitorFiles,
MonitorFilePath,
monitorFile,
monitorFileHashed,
monitorNonExistentFile,
monitorDirectory,
monitorNonExistentDirectory,
monitorDirectoryExistence,
monitorFileOrDirectory,
monitorFileSearchPath,
monitorFileHashedSearchPath,
monitorFileGlob,
monitorFileGlobExistence,
FilePathGlob(..),
FilePathRoot(..),
FilePathGlobRel(..),
GlobPiece(..),
FileMonitor(..),
newFileMonitor,
rerunIfChanged,
delayInitSharedResource,
delayInitSharedResources,
matchFileGlob,
getDirectoryContentsMonitored,
createDirectoryMonitored,
monitorDirectoryStatus,
doesFileExistMonitored,
need,
needIfExists,
findFileWithExtensionMonitored,
findFirstFileMonitored,
findFileMonitored,
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.FileMonitor
import Distribution.Client.Glob hiding (matchFileGlob)
import qualified Distribution.Client.Glob as Glob (matchFileGlob)
import Distribution.Simple.Utils (debug)
import qualified Data.Map.Strict as Map
import Control.Monad.State as State
import Control.Monad.Reader as Reader
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)
import System.FilePath
import System.Directory
newtype Rebuild a = Rebuild (ReaderT FilePath (StateT [MonitorFilePath] IO) a)
deriving (forall a b. a -> Rebuild b -> Rebuild a
forall a b. (a -> b) -> Rebuild a -> Rebuild b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Rebuild b -> Rebuild a
$c<$ :: forall a b. a -> Rebuild b -> Rebuild a
fmap :: forall a b. (a -> b) -> Rebuild a -> Rebuild b
$cfmap :: forall a b. (a -> b) -> Rebuild a -> Rebuild b
Functor, Functor Rebuild
forall a. a -> Rebuild a
forall a b. Rebuild a -> Rebuild b -> Rebuild a
forall a b. Rebuild a -> Rebuild b -> Rebuild b
forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b
forall a b c. (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Rebuild a -> Rebuild b -> Rebuild a
$c<* :: forall a b. Rebuild a -> Rebuild b -> Rebuild a
*> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
$c*> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
liftA2 :: forall a b c. (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c
<*> :: forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b
$c<*> :: forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b
pure :: forall a. a -> Rebuild a
$cpure :: forall a. a -> Rebuild a
Applicative, Applicative Rebuild
forall a. a -> Rebuild a
forall a b. Rebuild a -> Rebuild b -> Rebuild b
forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Rebuild a
$creturn :: forall a. a -> Rebuild a
>> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
$c>> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
>>= :: forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
$c>>= :: forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
Monad, Monad Rebuild
forall a. IO a -> Rebuild a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Rebuild a
$cliftIO :: forall a. IO a -> Rebuild a
MonadIO)
monitorFiles :: [MonitorFilePath] -> Rebuild ()
monitorFiles :: [MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
filespecs = forall a.
ReaderT FilePath (StateT [MonitorFilePath] IO) a -> Rebuild a
Rebuild (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ([MonitorFilePath]
filespecsforall a. [a] -> [a] -> [a]
++))
unRebuild :: FilePath -> Rebuild a -> IO (a, [MonitorFilePath])
unRebuild :: forall a. FilePath -> Rebuild a -> IO (a, [MonitorFilePath])
unRebuild FilePath
rootDir (Rebuild ReaderT FilePath (StateT [MonitorFilePath] IO) a
action) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []
runRebuild :: FilePath -> Rebuild a -> IO a
runRebuild :: forall a. FilePath -> Rebuild a -> IO a
runRebuild FilePath
rootDir (Rebuild ReaderT FilePath (StateT [MonitorFilePath] IO) a
action) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []
execRebuild :: FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild :: forall a. FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild FilePath
rootDir (Rebuild ReaderT FilePath (StateT [MonitorFilePath] IO) a
action) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []
askRoot :: Rebuild FilePath
askRoot :: Rebuild FilePath
askRoot = forall a.
ReaderT FilePath (StateT [MonitorFilePath] IO) a -> Rebuild a
Rebuild forall r (m :: * -> *). MonadReader r m => m r
Reader.ask
rerunIfChanged :: (Binary a, Structured a, Binary b, Structured b)
=> Verbosity
-> FileMonitor a b
-> a
-> Rebuild b
-> Rebuild b
rerunIfChanged :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity FileMonitor a b
monitor a
key Rebuild b
action = do
FilePath
rootDir <- Rebuild FilePath
askRoot
MonitorChanged a b
changed <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
checkFileMonitorChanged FileMonitor a b
monitor FilePath
rootDir a
key
case MonitorChanged a b
changed of
MonitorUnchanged b
result [MonitorFilePath]
files -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"File monitor '" forall a. [a] -> [a] -> [a]
++ FilePath
monitorName
forall a. [a] -> [a] -> [a]
++ FilePath
"' unchanged."
[MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
files
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
MonitorChanged MonitorChangedReason a
reason -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"File monitor '" forall a. [a] -> [a] -> [a]
++ FilePath
monitorName
forall a. [a] -> [a] -> [a]
++ FilePath
"' changed: " forall a. [a] -> [a] -> [a]
++ forall {a}. MonitorChangedReason a -> FilePath
showReason MonitorChangedReason a
reason
MonitorTimestamp
startTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO MonitorTimestamp
beginUpdateFileMonitor
(b
result, [MonitorFilePath]
files) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> Rebuild a -> IO (a, [MonitorFilePath])
unRebuild FilePath
rootDir Rebuild b
action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
updateFileMonitor FileMonitor a b
monitor FilePath
rootDir
(forall a. a -> Maybe a
Just MonitorTimestamp
startTime) [MonitorFilePath]
files a
key b
result
[MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
files
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
where
monitorName :: FilePath
monitorName = FilePath -> FilePath
takeFileName (forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile FileMonitor a b
monitor)
showReason :: MonitorChangedReason a -> FilePath
showReason (MonitoredFileChanged FilePath
file) = FilePath
"file " forall a. [a] -> [a] -> [a]
++ FilePath
file
showReason (MonitoredValueChanged a
_) = FilePath
"monitor value changed"
showReason MonitorChangedReason a
MonitorFirstRun = FilePath
"first run"
showReason MonitorChangedReason a
MonitorCorruptCache = FilePath
"invalid cache file"
delayInitSharedResource :: forall a. IO a -> Rebuild (Rebuild a)
delayInitSharedResource :: forall a. IO a -> Rebuild (Rebuild a)
delayInitSharedResource IO a
action = do
MVar (Maybe a)
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar (Maybe a) -> IO a
getOrInitResource MVar (Maybe a)
var))
where
getOrInitResource :: MVar (Maybe a) -> IO a
getOrInitResource :: MVar (Maybe a) -> IO a
getOrInitResource MVar (Maybe a)
var =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe a)
var forall a b. (a -> b) -> a -> b
$ \Maybe a
mx ->
case Maybe a
mx of
Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x, a
x)
Maybe a
Nothing -> do
a
x <- IO a
action
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x, a
x)
delayInitSharedResources :: forall k v. Ord k
=> (k -> IO v)
-> Rebuild (k -> Rebuild v)
delayInitSharedResources :: forall k v. Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v)
delayInitSharedResources k -> IO v
action = do
MVar (Map k v)
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (MVar a)
newMVar forall k a. Map k a
Map.empty)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Map k v) -> k -> IO v
getOrInitResource MVar (Map k v)
var)
where
getOrInitResource :: MVar (Map k v) -> k -> IO v
getOrInitResource :: MVar (Map k v) -> k -> IO v
getOrInitResource MVar (Map k v)
var k
k =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Map k v)
var forall a b. (a -> b) -> a -> b
$ \Map k v
m ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
m of
Just v
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
m, v
x)
Maybe v
Nothing -> do
v
x <- k -> IO v
action k
k
let !m' :: Map k v
m' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k v
x Map k v
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
m', v
x)
matchFileGlob :: FilePathGlob -> Rebuild [FilePath]
matchFileGlob :: FilePathGlob -> Rebuild [FilePath]
matchFileGlob FilePathGlob
glob = do
FilePath
root <- Rebuild FilePath
askRoot
[MonitorFilePath] -> Rebuild ()
monitorFiles [FilePathGlob -> MonitorFilePath
monitorFileGlobExistence FilePathGlob
glob]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePathGlob -> IO [FilePath]
Glob.matchFileGlob FilePath
root FilePathGlob
glob
getDirectoryContentsMonitored :: FilePath -> Rebuild [FilePath]
getDirectoryContentsMonitored :: FilePath -> Rebuild [FilePath]
getDirectoryContentsMonitored FilePath
dir = do
Bool
exists <- FilePath -> Rebuild Bool
monitorDirectoryStatus FilePath
dir
if Bool
exists
then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
else forall (m :: * -> *) a. Monad m => a -> m a
return []
createDirectoryMonitored :: Bool -> FilePath -> Rebuild ()
createDirectoryMonitored :: Bool -> FilePath -> Rebuild ()
createDirectoryMonitored Bool
createParents FilePath
dir = do
[MonitorFilePath] -> Rebuild ()
monitorFiles [FilePath -> MonitorFilePath
monitorDirectoryExistence FilePath
dir]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
createParents FilePath
dir
monitorDirectoryStatus :: FilePath -> Rebuild Bool
monitorDirectoryStatus :: FilePath -> Rebuild Bool
monitorDirectoryStatus FilePath
dir = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
dir
[MonitorFilePath] -> Rebuild ()
monitorFiles [if Bool
exists
then FilePath -> MonitorFilePath
monitorDirectory FilePath
dir
else FilePath -> MonitorFilePath
monitorNonExistentDirectory FilePath
dir]
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
doesFileExistMonitored :: FilePath -> Rebuild Bool
doesFileExistMonitored :: FilePath -> Rebuild Bool
doesFileExistMonitored FilePath
f = do
FilePath
root <- Rebuild FilePath
askRoot
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f)
[MonitorFilePath] -> Rebuild ()
monitorFiles [if Bool
exists
then FilePath -> MonitorFilePath
monitorFileExistence FilePath
f
else FilePath -> MonitorFilePath
monitorNonExistentFile FilePath
f]
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
need :: FilePath -> Rebuild ()
need :: FilePath -> Rebuild ()
need FilePath
f = [MonitorFilePath] -> Rebuild ()
monitorFiles [FilePath -> MonitorFilePath
monitorFileHashed FilePath
f]
needIfExists :: FilePath -> Rebuild ()
needIfExists :: FilePath -> Rebuild ()
needIfExists FilePath
f = do
FilePath
root <- Rebuild FilePath
askRoot
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f)
[MonitorFilePath] -> Rebuild ()
monitorFiles [if Bool
exists
then FilePath -> MonitorFilePath
monitorFileHashed FilePath
f
else FilePath -> MonitorFilePath
monitorNonExistentFile FilePath
f]
findFileWithExtensionMonitored
:: [String]
-> [FilePath]
-> FilePath
-> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored :: [FilePath] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored [FilePath]
extensions [FilePath]
searchPath FilePath
baseName =
forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored forall a. a -> a
id
[ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
baseName FilePath -> FilePath -> FilePath
<.> FilePath
ext
| FilePath
path <- forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
, FilePath
ext <- forall a. Eq a => [a] -> [a]
nub [FilePath]
extensions ]
findFirstFileMonitored :: forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored :: forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored a -> FilePath
file = [a] -> Rebuild (Maybe a)
findFirst
where findFirst :: [a] -> Rebuild (Maybe a)
findFirst :: [a] -> Rebuild (Maybe a)
findFirst [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
findFirst (a
x:[a]
xs) = do Bool
exists <- FilePath -> Rebuild Bool
doesFileExistMonitored (a -> FilePath
file a
x)
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
else [a] -> Rebuild (Maybe a)
findFirst [a]
xs
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored [FilePath]
searchPath FilePath
fileName =
forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored forall a. a -> a
id
[ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
fileName
| FilePath
path <- forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath]