From 4a3a0bad0ecaea7d8c147ae425ded7a2e3d9ce54 Mon Sep 17 00:00:00 2001
From: Andrzej Rybczak <arybczak@users.noreply.github.com>
Date: Sat, 23 Sep 2023 17:16:08 +0200
Subject: [PATCH] Check modification time of directories (#19)

---
 CHANGELOG.md   |  3 +++
 ghc-tags.cabal |  2 +-
 src/Main.hs    | 46 +++++++++++++++++++++++++++++-----------------
 3 files changed, 33 insertions(+), 18 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index d0ad8ce..10ed2d5 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,6 @@
+# ghc-tags-1.8 (2023-??-??)
+* Check modification time of directories.
+
 # ghc-tags-1.7 (2023-06-29)
 * Add support for GHC 9.6 and drop support for GHC 9.0.
 
diff --git a/ghc-tags.cabal b/ghc-tags.cabal
index 395e167..749b1dd 100644
--- a/ghc-tags.cabal
+++ b/ghc-tags.cabal
@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                ghc-tags
-version:             1.7
+version:             1.8
 synopsis:            Utility for generating ctags and etags with GHC API.
 description:         Utility for generating etags (Emacs) and ctags (Vim and other
                      editors) with GHC API for efficient project navigation.
diff --git a/src/Main.hs b/src/Main.hs
index c17ebbe..32b3f22 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -75,27 +75,39 @@ generateTagsForProject threads wd pc = runConcurrently . F.fold
     processFiles = mapM_ $ \origPath -> do
       let path = normalise origPath
       unless (path `elem` pcExcludePaths pc) $ do
+        let tagPath = TagFileName (T.pack path)
         doesDirectoryExist path >>= \case
-          True -> do
-            paths <- map (path </>) <$> listDirectory path
-            processFiles paths
+          True -> showIOError $ do
+            -- Enter directories only if their mtime changed or is not recorded.
+            mtime <- getModificationTime path
+            goIn <- modifyMVar (wdTimes wd) $ \times -> do
+              let goIn = eligibleForUpdate tagPath mtime times
+              pure . (, goIn) $! if goIn
+                                 then updateTimesWith tagPath mtime times
+                                 else times
+            when goIn $ do
+              paths <- map (path </>) <$> listDirectory path
+              processFiles paths
           False -> F.forM_ (takeExtension path `lookup` haskellExts) $ \hsType -> do
             showIOError $ do
-              -- Source files are scanned and updated only if their mtime changed or
-              -- it's not recorded.
-              time <- getModificationTime path
-              updateTags <- withMVar (wdTimes wd) $ \times -> pure $
-                case TagFileName (T.pack path) `Map.lookup` times of
-                  -- If the file was already updated, it means it's eligible for
-                  -- the update with regard to its mtime, but it was already
-                  -- processed. In such case we let it through in order to
-                  -- support the case of parsing the same file multiple times
-                  -- with different CPP options.
-                  Just (Updated updated oldTime) -> updated || oldTime < time
-                  Nothing                        -> True
+              -- Source files are scanned and updated only if their mtime
+              -- changed or it's not recorded.
+              mtime <- getModificationTime path
+              updateTags <- withMVar (wdTimes wd) $ \times -> do
+                pure $ eligibleForUpdate tagPath mtime times
               when updateTags $ do
-                atomically . writeTBQueue (wdQueue wd) $ Just (path, hsType, time)
+                atomically . writeTBQueue (wdQueue wd) $ Just (path, hsType, mtime)
       where
+        eligibleForUpdate tagPath mtime times =
+          case tagPath `Map.lookup` times of
+            -- If the file was already updated, it means it's eligible for
+            -- the update with regard to its mtime, but it was already
+            -- processed. In such case we let it through in order to
+            -- support the case of parsing the same file multiple times
+            -- with different CPP options.
+            Just (Updated updated oldTime) -> updated || oldTime < mtime
+            Nothing                        -> True
+
         haskellExts = [ (".hs",      HsFile)
                       , (".hs-boot", HsBootFile)
                       , (".lhs",     LHsFile)
@@ -249,7 +261,7 @@ cleanupTimes Tags{..} = Map.traverseMaybeWithKey $ \file -> \case
     | updated || file `Map.member` tTags -> pure $ Just time
     | otherwise -> do
         let path = T.unpack $ getTagFileName file
-        doesFileExist path >>= \case
+        doesPathExist path >>= \case
           True  -> pure $ Just time
           False -> pure Nothing