{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | An abstraction for re-running actions if values or files have changed.
--
-- This is not a full-blown make-style incremental build system, it's a bit
-- more ad-hoc than that, but it's easier to integrate with existing code.
--
-- It's a convenient interface to the "Distribution.Client.FileMonitor"
-- functions.
module Distribution.Client.RebuildMonad
  ( -- * Rebuild monad
    Rebuild
  , runRebuild
  , execRebuild
  , askRoot

    -- * Setting up file monitoring
  , monitorFiles
  , MonitorFilePath
  , monitorFile
  , monitorFileHashed
  , monitorNonExistentFile
  , monitorDirectory
  , monitorNonExistentDirectory
  , monitorDirectoryExistence
  , monitorFileOrDirectory
  , monitorFileSearchPath
  , monitorFileHashedSearchPath

    -- ** Monitoring file globs
  , monitorFileGlob
  , monitorFileGlobExistence
  , RootedGlob (..)
  , FilePathRoot (..)
  , Glob (..)
  , GlobPiece (..)

    -- * Using a file monitor
  , FileMonitor (..)
  , newFileMonitor
  , rerunIfChanged
  , rerunConcurrentlyIfChanged

    -- * Utils
  , delayInitSharedResource
  , delayInitSharedResources
  , matchFileGlob
  , getDirectoryContentsMonitored
  , createDirectoryMonitored
  , monitorDirectoryStatus
  , doesFileExistMonitored
  , need
  , needIfExists
  , findFileWithExtensionMonitored
  , findFirstFileMonitored
  , findFileMonitored
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.FileMonitor
import Distribution.Client.Glob hiding (matchFileGlob)
import qualified Distribution.Client.Glob as Glob (matchFileGlob)
import Distribution.Client.JobControl
import Distribution.Simple.PreProcess.Types (Suffix (..))

import Distribution.Simple.Utils (debug)

import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)
import Control.Monad
import Control.Monad.Reader as Reader
import Control.Monad.State as State
import qualified Data.Map.Strict as Map
import System.Directory
import System.FilePath

-- | A monad layered on top of 'IO' to help with re-running actions when the
-- input files and values they depend on change. The crucial operations are
-- 'rerunIfChanged' and 'monitorFiles'.
newtype Rebuild a = Rebuild (ReaderT FilePath (StateT [MonitorFilePath] IO) a)
  deriving ((forall a b. (a -> b) -> Rebuild a -> Rebuild b)
-> (forall a b. a -> Rebuild b -> Rebuild a) -> Functor Rebuild
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
$cfmap :: forall a b. (a -> b) -> Rebuild a -> Rebuild b
fmap :: forall a b. (a -> b) -> Rebuild a -> Rebuild b
$c<$ :: forall a b. a -> Rebuild b -> Rebuild a
<$ :: forall a b. a -> Rebuild b -> Rebuild a
Functor, Functor Rebuild
Functor Rebuild =>
(forall a. a -> Rebuild a)
-> (forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b)
-> (forall a b c.
    (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c)
-> (forall a b. Rebuild a -> Rebuild b -> Rebuild b)
-> (forall a b. Rebuild a -> Rebuild b -> Rebuild a)
-> Applicative 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
$cpure :: forall a. a -> Rebuild a
pure :: forall a. a -> Rebuild a
$c<*> :: forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b
<*> :: forall a b. Rebuild (a -> b) -> Rebuild a -> Rebuild b
$cliftA2 :: forall a b c. (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c
liftA2 :: forall a b c. (a -> b -> c) -> Rebuild a -> Rebuild b -> Rebuild c
$c*> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
*> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
$c<* :: forall a b. Rebuild a -> Rebuild b -> Rebuild a
<* :: forall a b. Rebuild a -> Rebuild b -> Rebuild a
Applicative, Applicative Rebuild
Applicative Rebuild =>
(forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b)
-> (forall a b. Rebuild a -> Rebuild b -> Rebuild b)
-> (forall a. a -> Rebuild a)
-> Monad 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
$c>>= :: forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
>>= :: forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
$c>> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
>> :: forall a b. Rebuild a -> Rebuild b -> Rebuild b
$creturn :: forall a. a -> Rebuild a
return :: forall a. a -> Rebuild a
Monad, Monad Rebuild
Monad Rebuild => (forall a. IO a -> Rebuild a) -> MonadIO Rebuild
forall a. IO a -> Rebuild a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Rebuild a
liftIO :: forall a. IO a -> Rebuild a
MonadIO)

-- | Use this within the body action of 'rerunIfChanged' to declare that the
-- action depends on the given files. This can be based on what the action
-- actually did. It is these files that will be checked for changes next
-- time 'rerunIfChanged' is called for that 'FileMonitor'.
--
-- Relative paths are interpreted as relative to an implicit root, ultimately
-- passed in to 'runRebuild'.
monitorFiles :: [MonitorFilePath] -> Rebuild ()
monitorFiles :: [MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
filespecs = ReaderT FilePath (StateT [MonitorFilePath] IO) () -> Rebuild ()
forall a.
ReaderT FilePath (StateT [MonitorFilePath] IO) a -> Rebuild a
Rebuild (([MonitorFilePath] -> [MonitorFilePath])
-> ReaderT FilePath (StateT [MonitorFilePath] IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ([MonitorFilePath]
filespecs [MonitorFilePath] -> [MonitorFilePath] -> [MonitorFilePath]
forall a. [a] -> [a] -> [a]
++))

-- | Run a 'Rebuild' IO action.
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) = StateT [MonitorFilePath] IO a
-> [MonitorFilePath] -> IO (a, [MonitorFilePath])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT FilePath (StateT [MonitorFilePath] IO) a
-> FilePath -> StateT [MonitorFilePath] IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []

-- | Run a 'Rebuild' IO action.
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) = StateT [MonitorFilePath] IO a -> [MonitorFilePath] -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ReaderT FilePath (StateT [MonitorFilePath] IO) a
-> FilePath -> StateT [MonitorFilePath] IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []

-- | Run a 'Rebuild' IO action.
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) = StateT [MonitorFilePath] IO a
-> [MonitorFilePath] -> IO [MonitorFilePath]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (ReaderT FilePath (StateT [MonitorFilePath] IO) a
-> FilePath -> StateT [MonitorFilePath] IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FilePath (StateT [MonitorFilePath] IO) a
action FilePath
rootDir) []

-- | The root that relative paths are interpreted as being relative to.
askRoot :: Rebuild FilePath
askRoot :: Rebuild FilePath
askRoot = ReaderT FilePath (StateT [MonitorFilePath] IO) FilePath
-> Rebuild FilePath
forall a.
ReaderT FilePath (StateT [MonitorFilePath] IO) a -> Rebuild a
Rebuild ReaderT FilePath (StateT [MonitorFilePath] IO) FilePath
forall r (m :: * -> *). MonadReader r m => m r
Reader.ask

-- | This captures the standard use pattern for a 'FileMonitor': given a
-- monitor, an action and the input value the action depends on, either
-- re-run the action to get its output, or if the value and files the action
-- depends on have not changed then return a previously cached action result.
--
-- The result is still in the 'Rebuild' monad, so these can be nested.
--
-- Do not share 'FileMonitor's between different uses of 'rerunIfChanged'.
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
  -- rerunIfChanged is implemented in terms of rerunConcurrentlyIfChanged, but
  -- nothing concurrent will happen since the list of concurrent actions has a
  -- single value that will be waited for alone.
  Verbosity
-> IO (JobControl IO (b, [MonitorFilePath]))
-> [(FileMonitor a b, a, Rebuild b)]
-> Rebuild [b]
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity
-> IO (JobControl IO (b, [MonitorFilePath]))
-> [(FileMonitor a b, a, Rebuild b)]
-> Rebuild [b]
rerunConcurrentlyIfChanged Verbosity
verbosity IO (JobControl IO (b, [MonitorFilePath]))
forall a. IO (JobControl IO a)
newSerialJobControl [(FileMonitor a b
monitor, a
key, Rebuild b
action)] Rebuild [b] -> ([b] -> Rebuild b) -> Rebuild b
forall a b. Rebuild a -> (a -> Rebuild b) -> Rebuild b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [b
x] -> b -> Rebuild b
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
    [b]
_ -> FilePath -> Rebuild b
forall a. HasCallStack => FilePath -> a
error FilePath
"rerunIfChanged: impossible!"

-- | Like 'rerunIfChanged' meets 'mapConcurrently': For when we want multiple actions
-- that need to do be re-run-if-changed asynchronously. The function returns
-- when all values have finished computing.
rerunConcurrentlyIfChanged
  :: (Binary a, Structured a, Binary b, Structured b)
  => Verbosity
  -> IO (JobControl IO (b, [MonitorFilePath]))
  -> [(FileMonitor a b, a, Rebuild b)]
  -> Rebuild [b]
rerunConcurrentlyIfChanged :: forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity
-> IO (JobControl IO (b, [MonitorFilePath]))
-> [(FileMonitor a b, a, Rebuild b)]
-> Rebuild [b]
rerunConcurrentlyIfChanged Verbosity
verbosity IO (JobControl IO (b, [MonitorFilePath]))
mkJobControl [(FileMonitor a b, a, Rebuild b)]
triples = do
  FilePath
rootDir <- Rebuild FilePath
askRoot
  [IO (b, [MonitorFilePath])]
dacts <- [(FileMonitor a b, a, Rebuild b)]
-> ((FileMonitor a b, a, Rebuild b)
    -> Rebuild (IO (b, [MonitorFilePath])))
-> Rebuild [IO (b, [MonitorFilePath])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FileMonitor a b, a, Rebuild b)]
triples (((FileMonitor a b, a, Rebuild b)
  -> Rebuild (IO (b, [MonitorFilePath])))
 -> Rebuild [IO (b, [MonitorFilePath])])
-> ((FileMonitor a b, a, Rebuild b)
    -> Rebuild (IO (b, [MonitorFilePath])))
-> Rebuild [IO (b, [MonitorFilePath])]
forall a b. (a -> b) -> a -> b
$ \(FileMonitor a b
monitor, a
key, Rebuild b
action) -> do
    let monitorName :: FilePath
monitorName = FilePath -> FilePath
takeFileName (FileMonitor a b -> FilePath
forall a b. FileMonitor a b -> FilePath
fileMonitorCacheFile FileMonitor a b
monitor)
    MonitorChanged a b
changed <- IO (MonitorChanged a b) -> Rebuild (MonitorChanged a b)
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MonitorChanged a b) -> Rebuild (MonitorChanged a b))
-> IO (MonitorChanged a b) -> Rebuild (MonitorChanged a b)
forall a b. (a -> b) -> a -> b
$ FileMonitor a b -> FilePath -> a -> IO (MonitorChanged 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
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"File monitor '"
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
monitorName
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' unchanged."
        [MonitorFilePath] -> Rebuild ()
monitorFiles [MonitorFilePath]
files
        IO (b, [MonitorFilePath]) -> Rebuild (IO (b, [MonitorFilePath]))
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, [MonitorFilePath]) -> IO (b, [MonitorFilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
result, []))
      MonitorChanged MonitorChangedReason a
reason -> do
        IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"File monitor '"
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
monitorName
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' changed: "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ MonitorChangedReason a -> FilePath
forall {a}. MonitorChangedReason a -> FilePath
showReason MonitorChangedReason a
reason
        IO (b, [MonitorFilePath]) -> Rebuild (IO (b, [MonitorFilePath]))
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (b, [MonitorFilePath]) -> Rebuild (IO (b, [MonitorFilePath])))
-> IO (b, [MonitorFilePath]) -> Rebuild (IO (b, [MonitorFilePath]))
forall a b. (a -> b) -> a -> b
$ do
          MonitorTimestamp
startTime <- IO MonitorTimestamp
beginUpdateFileMonitor
          (b
result, [MonitorFilePath]
files) <- FilePath -> Rebuild b -> IO (b, [MonitorFilePath])
forall a. FilePath -> Rebuild a -> IO (a, [MonitorFilePath])
unRebuild FilePath
rootDir Rebuild b
action
          FileMonitor a b
-> FilePath
-> Maybe MonitorTimestamp
-> [MonitorFilePath]
-> a
-> b
-> IO ()
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
            (MonitorTimestamp -> Maybe MonitorTimestamp
forall a. a -> Maybe a
Just MonitorTimestamp
startTime)
            [MonitorFilePath]
files
            a
key
            b
result
          (b, [MonitorFilePath]) -> IO (b, [MonitorFilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
result, [MonitorFilePath]
files)

  ([b]
results, [[MonitorFilePath]]
files) <- IO ([b], [[MonitorFilePath]]) -> Rebuild ([b], [[MonitorFilePath]])
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([b], [[MonitorFilePath]])
 -> Rebuild ([b], [[MonitorFilePath]]))
-> IO ([b], [[MonitorFilePath]])
-> Rebuild ([b], [[MonitorFilePath]])
forall a b. (a -> b) -> a -> b
$
    IO (JobControl IO (b, [MonitorFilePath]))
-> (JobControl IO (b, [MonitorFilePath])
    -> IO ([b], [[MonitorFilePath]]))
-> IO ([b], [[MonitorFilePath]])
forall a b.
IO (JobControl IO a) -> (JobControl IO a -> IO b) -> IO b
withJobControl IO (JobControl IO (b, [MonitorFilePath]))
mkJobControl ((JobControl IO (b, [MonitorFilePath])
  -> IO ([b], [[MonitorFilePath]]))
 -> IO ([b], [[MonitorFilePath]]))
-> (JobControl IO (b, [MonitorFilePath])
    -> IO ([b], [[MonitorFilePath]]))
-> IO ([b], [[MonitorFilePath]])
forall a b. (a -> b) -> a -> b
$ \JobControl IO (b, [MonitorFilePath])
jobControl -> do
      [(b, [MonitorFilePath])] -> ([b], [[MonitorFilePath]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(b, [MonitorFilePath])] -> ([b], [[MonitorFilePath]]))
-> IO [(b, [MonitorFilePath])] -> IO ([b], [[MonitorFilePath]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JobControl IO (b, [MonitorFilePath])
-> (IO (b, [MonitorFilePath]) -> IO (b, [MonitorFilePath]))
-> [IO (b, [MonitorFilePath])]
-> IO [(b, [MonitorFilePath])]
forall b a. JobControl IO b -> (a -> IO b) -> [a] -> IO [b]
mapConcurrentWithJobs JobControl IO (b, [MonitorFilePath])
jobControl IO (b, [MonitorFilePath]) -> IO (b, [MonitorFilePath])
forall a. a -> a
id [IO (b, [MonitorFilePath])]
dacts
  [MonitorFilePath] -> Rebuild ()
monitorFiles ([[MonitorFilePath]] -> [MonitorFilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MonitorFilePath]]
files)
  [b] -> Rebuild [b]
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
results
  where
    showReason :: MonitorChangedReason a -> FilePath
showReason (MonitoredFileChanged FilePath
file) = FilePath
"file " FilePath -> FilePath -> FilePath
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"

-- | When using 'rerunIfChanged' for each element of a list of actions, it is
-- sometimes the case that each action needs to make use of some resource. e.g.
--
-- > sequence
-- >   [ rerunIfChanged verbosity monitor key $ do
-- >       resource <- mkResource
-- >       ... -- use the resource
-- >   | ... ]
--
-- For efficiency one would like to share the resource between the actions
-- but the straightforward way of doing this means initialising it every time
-- even when no actions need re-running.
--
-- > resource <- mkResource
-- > sequence
-- >   [ rerunIfChanged verbosity monitor key $ do
-- >       ... -- use the resource
-- >   | ... ]
--
-- This utility allows one to get the best of both worlds:
--
-- > getResource <- delayInitSharedResource mkResource
-- > sequence
-- >   [ rerunIfChanged verbosity monitor key $ do
-- >       resource <- getResource
-- >       ... -- use the resource
-- >   | ... ]
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 <- IO (MVar (Maybe a)) -> Rebuild (MVar (Maybe a))
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe a -> IO (MVar (Maybe a))
forall a. a -> IO (MVar a)
newMVar Maybe a
forall a. Maybe a
Nothing)
  Rebuild a -> Rebuild (Rebuild a)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> Rebuild a
forall a. IO a -> Rebuild a
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 =
      MVar (Maybe a) -> (Maybe a -> IO (Maybe a, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe a)
var ((Maybe a -> IO (Maybe a, a)) -> IO a)
-> (Maybe a -> IO (Maybe a, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \Maybe a
mx ->
        case Maybe a
mx of
          Just a
x -> (Maybe a, a) -> IO (Maybe a, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x, a
x)
          Maybe a
Nothing -> do
            a
x <- IO a
action
            (Maybe a, a) -> IO (Maybe a, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x, a
x)

-- | Much like 'delayInitSharedResource' but for a keyed set of resources.
--
-- > getResource <- delayInitSharedResource mkResource
-- > sequence
-- >   [ rerunIfChanged verbosity monitor key $ do
-- >       resource <- getResource key
-- >       ... -- use the resource
-- >   | ... ]
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 <- IO (MVar (Map k v)) -> Rebuild (MVar (Map k v))
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Map k v -> IO (MVar (Map k v))
forall a. a -> IO (MVar a)
newMVar Map k v
forall k a. Map k a
Map.empty)
  (k -> Rebuild v) -> Rebuild (k -> Rebuild v)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO v -> Rebuild v
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO v -> Rebuild v) -> (k -> IO v) -> k -> Rebuild v
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 =
      MVar (Map k v) -> (Map k v -> IO (Map k v, v)) -> IO v
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Map k v)
var ((Map k v -> IO (Map k v, v)) -> IO v)
-> (Map k v -> IO (Map k v, v)) -> IO v
forall a b. (a -> b) -> a -> b
$ \Map k v
m ->
        case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
m of
          Just v
x -> (Map k v, v) -> IO (Map k v, v)
forall a. a -> IO a
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' = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k v
x Map k v
m
            (Map k v, v) -> IO (Map k v, v)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
m', v
x)

-- | 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 monitors the given glob
-- for changes.
matchFileGlob :: RootedGlob -> Rebuild [FilePath]
matchFileGlob :: RootedGlob -> Rebuild [FilePath]
matchFileGlob RootedGlob
glob = do
  FilePath
root <- Rebuild FilePath
askRoot
  [MonitorFilePath] -> Rebuild ()
monitorFiles [RootedGlob -> MonitorFilePath
monitorFileGlobExistence RootedGlob
glob]
  IO [FilePath] -> Rebuild [FilePath]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Rebuild [FilePath])
-> IO [FilePath] -> Rebuild [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> RootedGlob -> IO [FilePath]
Glob.matchFileGlob FilePath
root RootedGlob
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 IO [FilePath] -> Rebuild [FilePath]
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Rebuild [FilePath])
-> IO [FilePath] -> Rebuild [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
    else [FilePath] -> Rebuild [FilePath]
forall a. a -> Rebuild a
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]
  IO () -> Rebuild ()
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Rebuild ()) -> IO () -> Rebuild ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
createParents FilePath
dir

-- | Monitor a directory as in 'monitorDirectory' if it currently exists or
-- as 'monitorNonExistentDirectory' if it does not.
monitorDirectoryStatus :: FilePath -> Rebuild Bool
monitorDirectoryStatus :: FilePath -> Rebuild Bool
monitorDirectoryStatus FilePath
dir = do
  Bool
exists <- IO Bool -> Rebuild Bool
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Rebuild Bool) -> IO Bool -> Rebuild Bool
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
    ]
  Bool -> Rebuild Bool
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists

-- | Like 'doesFileExist', but in the 'Rebuild' monad.  This does
-- NOT track the contents of 'FilePath'; use 'need' in that case.
doesFileExistMonitored :: FilePath -> Rebuild Bool
doesFileExistMonitored :: FilePath -> Rebuild Bool
doesFileExistMonitored FilePath
f = do
  FilePath
root <- Rebuild FilePath
askRoot
  Bool
exists <- IO Bool -> Rebuild Bool
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Rebuild Bool) -> IO Bool -> Rebuild Bool
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
    ]
  Bool -> Rebuild Bool
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists

-- | Monitor a single file
need :: FilePath -> Rebuild ()
need :: FilePath -> Rebuild ()
need FilePath
f = [MonitorFilePath] -> Rebuild ()
monitorFiles [FilePath -> MonitorFilePath
monitorFileHashed FilePath
f]

-- | Monitor a file if it exists; otherwise check for when it
-- gets created.  This is a bit better for recompilation avoidance
-- because sometimes users give bad package metadata, and we don't
-- want to repeatedly rebuild in this case (which we would if we
-- need'ed a non-existent file).
needIfExists :: FilePath -> Rebuild ()
needIfExists :: FilePath -> Rebuild ()
needIfExists FilePath
f = do
  FilePath
root <- Rebuild FilePath
askRoot
  Bool
exists <- IO Bool -> Rebuild Bool
forall a. IO a -> Rebuild a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Rebuild Bool) -> IO Bool -> Rebuild Bool
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
    ]

-- | Like 'findFileWithExtension', but in the 'Rebuild' monad.
findFileWithExtensionMonitored
  :: [Suffix]
  -> [FilePath]
  -> FilePath
  -> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored :: [Suffix] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored [Suffix]
extensions [FilePath]
searchPath FilePath
baseName =
  (FilePath -> FilePath) -> [FilePath] -> Rebuild (Maybe FilePath)
forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored
    FilePath -> FilePath
forall a. a -> a
id
    [ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
baseName FilePath -> FilePath -> FilePath
<.> FilePath
ext
    | FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
    , Suffix FilePath
ext <- [Suffix] -> [Suffix]
forall a. Eq a => [a] -> [a]
nub [Suffix]
extensions
    ]

-- | Like 'findFirstFile', but in the 'Rebuild' monad.
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 [] = Maybe a -> Rebuild (Maybe a)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
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 Maybe a -> Rebuild (Maybe a)
forall a. a -> Rebuild a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
        else [a] -> Rebuild (Maybe a)
findFirst [a]
xs

-- | Like 'findFile', but in the 'Rebuild' monad.
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored [FilePath]
searchPath FilePath
fileName =
  (FilePath -> FilePath) -> [FilePath] -> Rebuild (Maybe FilePath)
forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored
    FilePath -> FilePath
forall a. a -> a
id
    [ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
fileName
    | FilePath
path <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
searchPath
    ]