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 diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs index d5c0dd05f5..5a039da59e 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. (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) +make :: forall m. (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadIO m) => MakeActions m -> [CST.PartialResult Module] -> m [ExternsFile] @@ -177,7 +177,10 @@ 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 + let moduleSet = S.fromList $ map (getModuleName . CST.resPartial) sorted + writeCacheDb + =<< Cache.removeModules (M.keysSet failures) + <$> pruneMissingFiles (pruneMissingModules moduleSet newCacheDb) writePackageJson @@ -261,6 +264,25 @@ 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. + -- 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. inferForeignModules diff --git a/tests/TestMake.hs b/tests/TestMake.hs index 7e41411e95..ea80fc20d0 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,57 @@ 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"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] + + 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"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] + + writeFileWithTimestamp modulePath timestampA "module Module2 where\nfoo = 0\n" + compile [modulePath] `shouldReturn` moduleNames ["Module2"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module2"] + + 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"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module1"] + + removeFile modulePath1 + let modulePath2 = sourcesDir "Module2.purs" + + writeFileWithTimestamp modulePath2 timestampA "module Module2 where\nfoo = 0\n" + compile [modulePath2] `shouldReturn` moduleNames ["Module2"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module2"] + + 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"] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames ["Module"] + + removeFile modulePath + + compile [] `shouldReturn` moduleNames [] + + M.keysSet <$> readCacheDb `shouldReturn` moduleNames [] + -- Note [Sleeping to avoid flaky tests] -- -- One of the things we want to test here is that all requested output files @@ -269,8 +322,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" -