From 6cf6b85b3543f122c838e78251ed2ee6f93e98c6 Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Thu, 20 Oct 2022 14:51:04 +0200 Subject: [PATCH 1/7] Remove missing files from cache-db --- src/Language/PureScript/Make.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index d9e7157f16..acfa8e5661 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -136,7 +136,7 @@ rebuildModuleWithIndex MakeActions{..} exEnv externs m@(Module _ _ moduleName _ -- -- If timestamps or hashes have not changed, existing externs files can be used to provide upstream modules' types without -- having to typecheck those modules again. -make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) +make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadIO m) => MakeActions m -> [CST.PartialResult Module] -> m [ExternsFile] @@ -177,7 +177,7 @@ make ma@MakeActions{..} ms = do M.mapEither splitResults <$> BuildPlan.collectResults buildPlan -- Write the updated build cache database to disk - writeCacheDb $ Cache.removeModules (M.keysSet failures) newCacheDb + writeCacheDb =<< Cache.removeModules (M.keysSet failures) <$> pruneCache newCacheDb writePackageJson @@ -261,6 +261,17 @@ make ma@MakeActions{..} ms = do onExceptionLifted :: m a -> m b -> m a onExceptionLifted l r = control $ \runInIO -> runInIO l `onException` runInIO r + -- Remove missing files from the cache. + -- If a module ends up having no files, remove the module as well. + pruneCache :: Cache.CacheDb -> m Cache.CacheDb + pruneCache = M.traverseMaybeWithKey (\_ files -> do + prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files + if M.null prunedFiles then + pure Nothing + else + pure (Just $ Cache.CacheInfo prunedFiles) + ) + -- | Infer the module name for a module by looking for the same filename with -- a .js extension. inferForeignModules From 615b2ba0ac8b23a2327350cd2829c826509e9998 Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Wed, 26 Oct 2022 10:47:38 +0200 Subject: [PATCH 2/7] Remove duplicate source files from cache-db.json Modules are now removed if they are not being compiled and another module has the same source. --- src/Language/PureScript/Make.hs | 53 ++++++++++++++++++++++++++------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index acfa8e5661..375964d991 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -177,7 +177,9 @@ make ma@MakeActions{..} ms = do M.mapEither splitResults <$> BuildPlan.collectResults buildPlan -- Write the updated build cache database to disk - writeCacheDb =<< Cache.removeModules (M.keysSet failures) <$> pruneCache newCacheDb + writeCacheDb + =<< Cache.removeModules (M.keysSet failures) + <$> pruneCache (S.fromList $ map (getModuleName . CST.resPartial) sorted) newCacheDb writePackageJson @@ -261,16 +263,45 @@ make ma@MakeActions{..} ms = do onExceptionLifted :: m a -> m b -> m a onExceptionLifted l r = control $ \runInIO -> runInIO l `onException` runInIO r - -- Remove missing files from the cache. - -- If a module ends up having no files, remove the module as well. - pruneCache :: Cache.CacheDb -> m Cache.CacheDb - pruneCache = M.traverseMaybeWithKey (\_ files -> do - prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files - if M.null prunedFiles then - pure Nothing - else - pure (Just $ Cache.CacheInfo prunedFiles) - ) + -- Remove missing and duplicate files from the cache. + -- This action removes modules if their source does not exist or if another + -- module with the same source is being compiled. + pruneCache :: S.Set ModuleName -> Cache.CacheDb -> m Cache.CacheDb + pruneCache modules cache = + let + inverseCache :: M.Map FilePath [ModuleName] + inverseCache = M.foldlWithKey + (\acc key e -> M.unionWith (++) acc $ foldl (\acc2 file -> M.insert file [key] acc2) M.empty (M.keys (Cache.unCacheInfo e))) + M.empty + cache + + -- Set of modules that should be removed due to there being two or more modules with the same source + toRemove :: S.Set ModuleName + toRemove = M.foldl + (\acc e -> case e of + -- This pattern will clean up duplicates over time. + -- It will keep the cache in a good state if it was in a good state before. + m1 : m2 : _ -> + let + acc2 = if not $ S.member m1 modules then S.insert m1 acc else acc + acc3 = if not $ S.member m2 modules then S.insert m2 acc2 else acc2 + in + acc3 + _ -> acc + ) + S.empty + inverseCache + in + M.traverseMaybeWithKey (\moduleName files -> + if S.member moduleName toRemove then + pure Nothing + else do + prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files + if M.null prunedFiles then + pure Nothing + else + pure (Just $ Cache.CacheInfo prunedFiles) + ) cache -- | Infer the module name for a module by looking for the same filename with -- a .js extension. From 89c1ced84b8e025682e4044f7e13448c12dacd1a Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Wed, 26 Oct 2022 11:03:37 +0200 Subject: [PATCH 3/7] Refactor --- src/Language/PureScript/Make.hs | 66 ++++++++++++++++----------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index 375964d991..062889664e 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -268,40 +268,40 @@ make ma@MakeActions{..} ms = do -- module with the same source is being compiled. pruneCache :: S.Set ModuleName -> Cache.CacheDb -> m Cache.CacheDb pruneCache modules cache = - let - inverseCache :: M.Map FilePath [ModuleName] - inverseCache = M.foldlWithKey - (\acc key e -> M.unionWith (++) acc $ foldl (\acc2 file -> M.insert file [key] acc2) M.empty (M.keys (Cache.unCacheInfo e))) - M.empty - cache - - -- Set of modules that should be removed due to there being two or more modules with the same source - toRemove :: S.Set ModuleName - toRemove = M.foldl - (\acc e -> case e of - -- This pattern will clean up duplicates over time. - -- It will keep the cache in a good state if it was in a good state before. - m1 : m2 : _ -> - let - acc2 = if not $ S.member m1 modules then S.insert m1 acc else acc - acc3 = if not $ S.member m2 modules then S.insert m2 acc2 else acc2 - in - acc3 - _ -> acc - ) - S.empty - inverseCache - in - M.traverseMaybeWithKey (\moduleName files -> - if S.member moduleName toRemove then + let + inverseCache :: M.Map FilePath [ModuleName] + inverseCache = + M.foldlWithKey + (\acc1 key e -> M.unionWith (++) acc1 $ foldl (\acc2 file -> M.insert file [key] acc2) M.empty (M.keys (Cache.unCacheInfo e))) + M.empty + cache + + -- Set of modules that should be removed due to there being two or more modules with the same source + toRemove :: S.Set ModuleName + toRemove = + M.foldl + (\acc1 e -> case e of + -- This pattern will clean up duplicates over time. + -- It will keep the cache in a good state if it was in a good state before. + m1 : m2 : _ -> + let + acc2 = if not $ S.member m1 modules then S.insert m1 acc1 else acc1 + acc3 = if not $ S.member m2 modules then S.insert m2 acc2 else acc2 + in + acc3 + _ -> acc1 + ) + S.empty + inverseCache + in + M.traverseMaybeWithKey (\_ files -> + do + prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files + if M.null prunedFiles then pure Nothing - else do - prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files - if M.null prunedFiles then - pure Nothing - else - pure (Just $ Cache.CacheInfo prunedFiles) - ) cache + else + pure (Just $ Cache.CacheInfo prunedFiles) + ) $ Cache.removeModules toRemove cache -- | Infer the module name for a module by looking for the same filename with -- a .js extension. From c621cc0fd676e60f9e613dad586ff2ea28c809d3 Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Fri, 18 Nov 2022 14:22:50 +0100 Subject: [PATCH 4/7] Add tests --- tests/TestMake.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 75f422e8ac..67193c4a30 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -13,12 +13,14 @@ import Control.Monad import Control.Exception (tryJust) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.MVar (readMVar, newMVar, modifyMVar_) +import qualified Data.Aeson as Aeson import Data.Time.Calendar import Data.Time.Clock import qualified Data.Text as T import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Map as M +import Language.PureScript.Make.Cache (CacheDb) import System.FilePath import System.Directory @@ -196,6 +198,78 @@ spec = do -- recompiled. go optsCorefnOnly `shouldReturn` moduleNames ["Module"] + it "writes cache-db.json" $ do + let modulePath = sourcesDir "Module.purs" + + writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" + compile [modulePath] `shouldReturn` moduleNames ["Module"] + + cache <- readCacheDb + if M.keysSet cache == moduleNames ["Module"] + then return () + else fail "Module not in cacheDb" + + it "removes old entry from cache when module is renamed" $ do + let modulePath = sourcesDir "Module.purs" + + writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" + compile [modulePath] `shouldReturn` moduleNames ["Module"] + + cache1 <- readCacheDb + if M.keysSet cache1 == moduleNames ["Module"] + then return () + else fail "Module not in cacheDb" + + writeFileWithTimestamp modulePath timestampA "module Module2 where\nfoo = 0\n" + compile [modulePath] `shouldReturn` moduleNames ["Module2"] + + cache2 <- readCacheDb + if M.keysSet cache2 == moduleNames ["Module2"] + then return () + else fail "Module2 not in cacheDb" + + it "removes old entry from cache when file and module is renamed" $ do + let modulePath1 = sourcesDir "Module1.purs" + + writeFileWithTimestamp modulePath1 timestampA "module Module1 where\nfoo = 0\n" + compile [modulePath1] `shouldReturn` moduleNames ["Module1"] + + cache1 <- readCacheDb + if M.keysSet cache1 == moduleNames ["Module1"] + then return () + else fail "Module1 not in cacheDb" + + removeFile modulePath1 + let modulePath2 = sourcesDir "Module2.purs" + + writeFileWithTimestamp modulePath2 timestampA "module Module2 where\nfoo = 0\n" + compile [modulePath2] `shouldReturn` moduleNames ["Module2"] + + cache2 <- readCacheDb + if M.keysSet cache2 == moduleNames ["Module2"] + then return () + else fail "Module2 not in cacheDb" + + it "removes old entry from cache when file is deleted" $ do + let modulePath = sourcesDir "Module.purs" + + writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" + compile [modulePath] `shouldReturn` moduleNames ["Module"] + + cache1 <- readCacheDb + if M.keysSet cache1 == moduleNames ["Module"] + then return () + else fail "Module not in cacheDb" + + removeFile modulePath + + compile [] `shouldReturn` moduleNames [] + + cache2 <- readCacheDb + if M.null cache2 + then return () + else fail "Modules were not removed from cacheDb" + -- Note [Sleeping to avoid flaky tests] -- -- One of the things we want to test here is that all requested output files @@ -269,8 +343,15 @@ writeFileWithTimestamp path mtime contents = do writeUTF8FileT path contents setModificationTime path mtime +readCacheDb :: IO CacheDb +readCacheDb = do + let cachePath = modulesDir "cache-db.json" + maybeCache :: Maybe CacheDb <- Aeson.decodeFileStrict' cachePath + case maybeCache of + Just cache -> return cache + Nothing -> fail "CacheDb could not be read" + -- | Use a different output directory to ensure that we don't get interference -- from other test results modulesDir :: FilePath modulesDir = ".test_modules" "make" - From c653de975338fa975d47a12285e8b775882f0c3e Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Fri, 18 Nov 2022 14:35:07 +0100 Subject: [PATCH 5/7] Add change log file --- CHANGELOG.d/fix_invalid-entries-in-cache-db.md | 1 + 1 file changed, 1 insertion(+) create mode 100644 CHANGELOG.d/fix_invalid-entries-in-cache-db.md diff --git a/CHANGELOG.d/fix_invalid-entries-in-cache-db.md b/CHANGELOG.d/fix_invalid-entries-in-cache-db.md new file mode 100644 index 0000000000..6daec1c8cc --- /dev/null +++ b/CHANGELOG.d/fix_invalid-entries-in-cache-db.md @@ -0,0 +1 @@ +* Invalid entries are now removed from cache-db.json From 2ad7cd7760bedd7c34a564e227a49f65a1952d1a Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Sat, 28 Jan 2023 11:16:43 +0100 Subject: [PATCH 6/7] Refactor cache test code --- tests/TestMake.hs | 35 +++++++---------------------------- 1 file changed, 7 insertions(+), 28 deletions(-) diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 67193c4a30..4c1e9a33d2 100644 --- a/tests/TestMake.hs +++ b/tests/TestMake.hs @@ -204,10 +204,7 @@ spec = do writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" compile [modulePath] `shouldReturn` moduleNames ["Module"] - cache <- readCacheDb - if M.keysSet cache == moduleNames ["Module"] - then return () - else fail "Module not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] it "removes old entry from cache when module is renamed" $ do let modulePath = sourcesDir "Module.purs" @@ -215,18 +212,12 @@ spec = do writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" compile [modulePath] `shouldReturn` moduleNames ["Module"] - cache1 <- readCacheDb - if M.keysSet cache1 == moduleNames ["Module"] - then return () - else fail "Module not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] writeFileWithTimestamp modulePath timestampA "module Module2 where\nfoo = 0\n" compile [modulePath] `shouldReturn` moduleNames ["Module2"] - cache2 <- readCacheDb - if M.keysSet cache2 == moduleNames ["Module2"] - then return () - else fail "Module2 not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module2"] it "removes old entry from cache when file and module is renamed" $ do let modulePath1 = sourcesDir "Module1.purs" @@ -234,10 +225,7 @@ spec = do writeFileWithTimestamp modulePath1 timestampA "module Module1 where\nfoo = 0\n" compile [modulePath1] `shouldReturn` moduleNames ["Module1"] - cache1 <- readCacheDb - if M.keysSet cache1 == moduleNames ["Module1"] - then return () - else fail "Module1 not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module1"] removeFile modulePath1 let modulePath2 = sourcesDir "Module2.purs" @@ -245,10 +233,7 @@ spec = do writeFileWithTimestamp modulePath2 timestampA "module Module2 where\nfoo = 0\n" compile [modulePath2] `shouldReturn` moduleNames ["Module2"] - cache2 <- readCacheDb - if M.keysSet cache2 == moduleNames ["Module2"] - then return () - else fail "Module2 not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module2"] it "removes old entry from cache when file is deleted" $ do let modulePath = sourcesDir "Module.purs" @@ -256,19 +241,13 @@ spec = do writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n" compile [modulePath] `shouldReturn` moduleNames ["Module"] - cache1 <- readCacheDb - if M.keysSet cache1 == moduleNames ["Module"] - then return () - else fail "Module not in cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] removeFile modulePath compile [] `shouldReturn` moduleNames [] - cache2 <- readCacheDb - if M.null cache2 - then return () - else fail "Modules were not removed from cacheDb" + M.keysSet <$> readCacheDb `shouldReturn` moduleNames [] -- Note [Sleeping to avoid flaky tests] -- From a8831046554358daa6b3e68303813e0ddd3c17c4 Mon Sep 17 00:00:00 2001 From: Erik Mattfolk Date: Sat, 28 Jan 2023 12:55:15 +0100 Subject: [PATCH 7/7] Simplify cache pruning implementation --- src/Language/PureScript/Make.hs | 60 +++++++++++---------------------- 1 file changed, 20 insertions(+), 40 deletions(-) diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index 062889664e..95e1d4fa2e 100644 --- a/src/Language/PureScript/Make.hs +++ b/src/Language/PureScript/Make.hs @@ -177,9 +177,10 @@ make ma@MakeActions{..} ms = do M.mapEither splitResults <$> BuildPlan.collectResults buildPlan -- Write the updated build cache database to disk + let moduleSet = S.fromList $ map (getModuleName . CST.resPartial) sorted writeCacheDb =<< Cache.removeModules (M.keysSet failures) - <$> pruneCache (S.fromList $ map (getModuleName . CST.resPartial) sorted) newCacheDb + <$> pruneMissingFiles (pruneMissingModules moduleSet newCacheDb) writePackageJson @@ -263,45 +264,24 @@ make ma@MakeActions{..} ms = do onExceptionLifted :: m a -> m b -> m a onExceptionLifted l r = control $ \runInIO -> runInIO l `onException` runInIO r - -- Remove missing and duplicate files from the cache. - -- This action removes modules if their source does not exist or if another - -- module with the same source is being compiled. - pruneCache :: S.Set ModuleName -> Cache.CacheDb -> m Cache.CacheDb - pruneCache modules cache = - let - inverseCache :: M.Map FilePath [ModuleName] - inverseCache = - M.foldlWithKey - (\acc1 key e -> M.unionWith (++) acc1 $ foldl (\acc2 file -> M.insert file [key] acc2) M.empty (M.keys (Cache.unCacheInfo e))) - M.empty - cache - - -- Set of modules that should be removed due to there being two or more modules with the same source - toRemove :: S.Set ModuleName - toRemove = - M.foldl - (\acc1 e -> case e of - -- This pattern will clean up duplicates over time. - -- It will keep the cache in a good state if it was in a good state before. - m1 : m2 : _ -> - let - acc2 = if not $ S.member m1 modules then S.insert m1 acc1 else acc1 - acc3 = if not $ S.member m2 modules then S.insert m2 acc2 else acc2 - in - acc3 - _ -> acc1 - ) - S.empty - inverseCache - in - M.traverseMaybeWithKey (\_ files -> - do - prunedFiles <- M.traverseMaybeWithKey (\name info -> fmap (fmap (const info)) (getTimestampMaybe name)) $ Cache.unCacheInfo files - if M.null prunedFiles then - pure Nothing - else - pure (Just $ Cache.CacheInfo prunedFiles) - ) $ Cache.removeModules toRemove cache + -- Remove missing files from the cache. + -- Will remove modules without files. + pruneMissingFiles :: Cache.CacheDb -> m Cache.CacheDb + pruneMissingFiles cache = + M.filter (not . null . Cache.unCacheInfo) + <$> traverse ( + fmap Cache.CacheInfo + . fmap M.fromList + . filterM (\(name, _) -> (/= Nothing) <$> getTimestampMaybe name) + . M.toList + . Cache.unCacheInfo + ) cache + + -- Remove modules which are currently not being compiled. + pruneMissingModules :: S.Set ModuleName -> Cache.CacheDb -> Cache.CacheDb + pruneMissingModules modules cache = + let missingModules = S.difference (S.fromList (M.keys cache)) modules + in Cache.removeModules missingModules cache -- | Infer the module name for a module by looking for the same filename with -- a .js extension.