Update the build cache after building every module by gorbak25 · Pull Request #3996 · purescript/purescript · GitHub
Skip to content

Update the build cache after building every module #3996

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
gorbak25 wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Update the build cache after building every module #3996

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CONTRIBUTORS.md
View file
Open in desktop
33 changes: 28 additions & 5 deletions src/Language/PureScript/Make.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,12 +134,17 @@ make ma@MakeActions{..} ms = do
(sorted, graph) <- sortModules Transitive (moduleSignature . CST.resPartial) ms

(buildPlan, newCacheDb) <- BuildPlan.construct ma cacheDb (sorted, graph)
-- Fork and let a separate thread handle the cache
rChan <- C.newChan
buildPlan' <- BuildPlan.setResultChannel buildPlan (Just rChan)
doneMVar <- C.newEmptyMVar
_ <- fork $ handleCache rChan cacheDb newCacheDb doneMVar

let toBeRebuilt = filter (BuildPlan.needsRebuild buildPlan . getModuleName . CST.resPartial) sorted
let toBeRebuilt = filter (BuildPlan.needsRebuild buildPlan' . getModuleName . CST.resPartial) sorted
for_ toBeRebuilt $ \m -> fork $ do
let moduleName = getModuleName . CST.resPartial $ m
let deps = fromMaybe (internalError "make: module not found in dependency graph.") (lookup moduleName graph)
buildModule buildPlan moduleName
buildModule buildPlan' moduleName
(spanName . getModuleSourceSpan . CST.resPartial $ m)
(fst $ CST.resFull m)
(fmap importPrim . snd $ CST.resFull m)
Expand All @@ -156,10 +161,12 @@ make ma@MakeActions{..} ms = do
BuildJobSkipped ->
Left mempty
in
M.mapEither splitResults <$> BuildPlan.collectResults buildPlan
M.mapEither splitResults <$> BuildPlan.collectResults buildPlan'

-- Write the updated build cache database to disk
writeCacheDb $ Cache.removeModules (M.keysSet failures) newCacheDb
-- Notify the cache handler that we are done
_ <- BuildPlan.setResultChannel buildPlan' Nothing
-- And wait for it to save everything
_ <- C.takeMVar doneMVar

-- If generating docs, also generate them for the Prim modules
outputPrimDocs
Expand Down Expand Up @@ -236,6 +243,22 @@ make ma@MakeActions{..} ms = do

BuildPlan.markComplete buildPlan moduleName result

handleCache :: ResultChannel -> Cache.CacheDb -> Cache.CacheDb -> MVar () -> m ()
handleCache rChan curDB finalDB doneMVar = do
r <- readChan rChan
case r of
Nothing -> do -- We are done
C.putMVar doneMVar ()
return ()
Just (mn, BuildJobSucceeded _ _) -> do -- Job succeeded - update cache key
let newDB = Cache.updateModule mn curDB finalDB
writeCacheDb newDB
handleCache rChan newDB finalDB doneMVar
Just (mn, _) -> do -- Job failed - remove cache key
let newDB = Cache.removeModule mn curDB
writeCacheDb newDB
handleCache rChan newDB finalDB doneMVar

-- | Infer the module name for a module by looking for the same filename with
-- a .js extension.
inferForeignModules
Expand Down
7 changes: 6 additions & 1 deletion src/Language/PureScript/Make/Actions.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,12 @@ writeCacheDb'
-> CacheDb
-- ^ The CacheDb to be written
-> m ()
writeCacheDb' = writeJSONFile . cacheDbFile
writeCacheDb' dir db = do
writeJSONFile file_tmp db
renameFile file_tmp file
where
file = cacheDbFile dir
file_tmp = file ++ ".tmp"

-- | A set of make actions that read and write modules from the given directory.
buildMakeActions
Expand Down
21 changes: 20 additions & 1 deletion src/Language/PureScript/Make/BuildPlan.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,12 @@
module Language.PureScript.Make.BuildPlan
( BuildPlan(bpEnv)
, BuildJobResult(..)
, ResultChannel
, buildJobSuccess
, buildJobFailure
, construct
, getResult
, setResultChannel
, collectResults
, markComplete
, needsRebuild
Expand Down Expand Up @@ -39,8 +41,12 @@ data BuildPlan = BuildPlan
{ bpPrebuilt :: M.Map ModuleName Prebuilt
, bpBuildJobs :: M.Map ModuleName BuildJob
, bpEnv :: C.MVar Env
, bpResultChan :: Maybe ResultChannel
-- ^^ Optional channel for reporting build results, By sending Nothing we indicate that the build is done
}

type ResultChannel = C.Chan (Maybe (ModuleName, BuildJobResult))

data Prebuilt = Prebuilt
{ pbModificationTime :: UTCTime
, pbExternsFile :: ExternsFile
Expand Down Expand Up @@ -93,6 +99,9 @@ markComplete
-> m ()
markComplete buildPlan moduleName result = do
let BuildJob rVar = fromMaybe (internalError "make: markComplete no barrier") $ M.lookup moduleName (bpBuildJobs buildPlan)
case bpResultChan buildPlan of
Just chan -> writeChan chan $ Just (moduleName, result)
Nothing -> return ()
putMVar rVar result

-- | Whether or not the module with the given ModuleName needs to be rebuilt
Expand Down Expand Up @@ -146,7 +155,7 @@ construct MakeActions{..} cacheDb (sorted, graph) = do
buildJobs <- foldM makeBuildJob M.empty toBeRebuilt
env <- C.newMVar primEnv
pure
( BuildPlan prebuilt buildJobs env
( BuildPlan prebuilt buildJobs env Nothing
, let
update = flip $ \s ->
M.alter (const (statusNewCacheInfo s)) (statusModuleName s)
Expand Down Expand Up @@ -214,6 +223,16 @@ construct MakeActions{..} cacheDb (sorted, graph) = do
prev
_ -> M.insert moduleName pb prev

setResultChannel :: forall m. (Monad m, MonadBaseControl IO m)
=> BuildPlan
-> Maybe ResultChannel
-> m BuildPlan
setResultChannel bp chan = do
case bpResultChan bp of
Just oldChan -> writeChan oldChan Nothing
Nothing -> return ()
pure $ bp { bpResultChan = chan }

maximumMaybe :: Ord a => [a] -> Maybe a
maximumMaybe [] = Nothing
maximumMaybe xs = Just $ maximum xs
19 changes: 13 additions & 6 deletions src/Language/PureScript/Make/Cache.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@ module Language.PureScript.Make.Cache
, CacheDb
, CacheInfo(..)
, checkChanged
, removeModules
, removeModule
, updateModule
, normaliseForCache
) where

Expand All @@ -24,7 +25,6 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Monoid (All(..))
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.These (These(..))
Expand Down Expand Up @@ -128,10 +128,17 @@ checkChanged cacheDb mn basePath currentInfo = do

pure (CacheInfo newInfo, getAll isUpToDate)

-- | Remove any modules from the given set from the cache database; used when
-- they failed to build.
removeModules :: Set ModuleName -> CacheDb -> CacheDb
removeModules moduleNames = flip Map.withoutKeys moduleNames
-- | Removes the given module from the cache database; used when
-- it failed to build.
removeModule :: ModuleName -> CacheDb -> CacheDb
removeModule = Map.delete

-- | Moves cache info between databases; used when a module was built successfully
updateModule :: ModuleName -> CacheDb -> CacheDb -> CacheDb
updateModule mn cur new =
case Map.lookup mn new of
Just r -> Map.insert mn r cur
Nothing -> Map.delete mn cur

-- | 1. Any path that is beneath our current working directory will be
-- stored as a normalised relative path
Expand Down
6 changes: 6 additions & 0 deletions src/Language/PureScript/Make/Monad.hs
View file
Open in desktop