From 4365bcb113ea77bf2783ab71f9fbf2db093850f7 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Sun, 13 Mar 2016 19:45:15 +0000
Subject: [PATCH] Add a couple glob utils
One for testing if globs are trivial, as in they're constant strings
without the possibility of matching more than one thing. This can help
with making better error messages.
Another util for matching file globs in the rebuild monad, and
automatically monitoring the glob.
---
cabal-install/Distribution/Client/FileMonitor.hs | 9 +++++++++
cabal-install/Distribution/Client/RebuildMonad.hs | 15 ++++++++++++++-
2 files changed, 23 insertions(+), 1 deletion(-)
diff --git a/cabal-install/Distribution/Client/FileMonitor.hs b/cabal-install/Distribution/Client/FileMonitor.hs
index affe9c70e5..c8c5c8486e 100644
--- a/cabal-install/Distribution/Client/FileMonitor.hs
+++ b/cabal-install/Distribution/Client/FileMonitor.hs
@@ -24,6 +24,7 @@ module Distribution.Client.FileMonitor (
beginUpdateFileMonitor,
matchFileGlob,
+ isTrivialFilePathGlob,
) where
@@ -805,6 +806,14 @@ matchFileGlob root glob0 = go glob0 ""
--TODO: [code cleanup] plausibly FilePathGlob and matchFileGlob should be
-- moved into D.C.Glob and/or merged with similar functionality in Cabal.
+
+isTrivialFilePathGlob :: FilePathGlob -> Maybe FilePath
+isTrivialFilePathGlob = go []
+ where
+ go paths (GlobDir (Glob [Literal path]) globs) = go (path:paths) globs
+ go paths (GlobFile (Glob [Literal path])) = Just (joinPath (reverse (path:paths)))
+ go _ _ = Nothing
+
-- | We really want to avoid re-hashing files all the time. We already make
-- the assumption that if a file mtime has not changed then we don't need to
-- bother checking if the content hash has changed. We can apply the same
diff --git a/cabal-install/Distribution/Client/RebuildMonad.hs b/cabal-install/Distribution/Client/RebuildMonad.hs
index cf0f44e864..c26c735a11 100644
--- a/cabal-install/Distribution/Client/RebuildMonad.hs
+++ b/cabal-install/Distribution/Client/RebuildMonad.hs
@@ -29,7 +29,8 @@ module Distribution.Client.RebuildMonad (
matchFileGlob,
) where
-import Distribution.Client.FileMonitor
+import Distribution.Client.FileMonitor hiding (matchFileGlob)
+import qualified Distribution.Client.FileMonitor as FileMonitor (matchFileGlob)
import Distribution.Simple.Utils (debug)
import Distribution.Verbosity (Verbosity)
@@ -107,3 +108,15 @@ rerunIfChanged verbosity rootDir monitor key action = do
showReason MonitorFirstRun = "first run"
showReason MonitorCorruptCache = "invalid cache file"
+
+-- | 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
+-- for changes.
+--
+matchFileGlob :: FilePath -> FilePathGlob -> Rebuild [FilePath]
+matchFileGlob root glob = do
+ monitorFiles [MonitorFileGlob glob]
+ liftIO $ FileMonitor.matchFileGlob root glob
+
--
GitLab