Don't fiddle with state in resolvedComps cacheAction

The general in-memory caching that was added to `cached` handles that
now making this fiddly workaround redundant.
This commit is contained in:
Daniel Gröber 2015-11-21 17:30:18 +01:00
parent a12a7fabc0
commit 4963b782d9
2 changed files with 14 additions and 15 deletions

View File

@ -214,10 +214,6 @@ resolvedComponentsCache distdir = Cached {
then Nothing then Nothing
else Just $ map Left changedFiles else Just $ map Left changedFiles
case (setupChanged, ma) of
(False, Just mcs) -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs }
_ -> return ()
let mdesc (Left f) = "file:" ++ f let mdesc (Left f) = "file:" ++ f
mdesc (Right mn) = "module:" ++ moduleNameString mn mdesc (Right mn) = "module:" ++ moduleNameString mn
@ -228,7 +224,8 @@ resolvedComponentsCache distdir = Cached {
gmLog GmDebug "resolvedComponentsCache" $ gmLog GmDebug "resolvedComponentsCache" $
text "files changed" <+>: changedDoc text "files changed" <+>: changedDoc
mcs <- resolveGmComponents mums comps mcs <- resolveGmComponents ((,) <$> mums <*> ma) comps
return (setupConfigPath distdir : flatten mcs , mcs) return (setupConfigPath distdir : flatten mcs , mcs)
} }
@ -386,27 +383,30 @@ resolveModule env srcDirs (Left fn') = do
-- | makeRelative dir fn /= fn -- | makeRelative dir fn /= fn
type CompilationUnit = Either FilePath ModuleName type CompilationUnit = Either FilePath ModuleName
type Components =
[GmComponent 'GMCRaw (Set ModulePath)]
type ResolvedComponentsMap =
Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath))
resolveGmComponents :: (IOish m, Gm m) resolveGmComponents :: (IOish m, Gm m)
=> Maybe [CompilationUnit] => Maybe ([CompilationUnit], ResolvedComponentsMap)
-- ^ Updated modules -- ^ Updated modules
-> [GmComponent 'GMCRaw (Set ModulePath)] -> Components -> m ResolvedComponentsMap
-> m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath))) resolveGmComponents mcache cs = do
resolveGmComponents mumns cs = do let rcm = fromMaybe Map.empty $ snd <$> mcache
s <- gmsGet
m' <- foldrM' (gmComponents s) cs $ \c m -> do m' <- foldrM' rcm cs $ \c m -> do
case Map.lookup (gmcName c) m of case Map.lookup (gmcName c) m of
Nothing -> insertUpdated m c Nothing -> insertUpdated m c
Just c' -> if same gmcRawEntrypoints c c' && same gmcGhcSrcOpts c c' Just c' -> if same gmcRawEntrypoints c c' && same gmcGhcSrcOpts c c'
then return m then return m
else insertUpdated m c else insertUpdated m c
gmsPut s { gmComponents = m' }
return m' return m'
where where
foldrM' b fa f = foldrM f b fa foldrM' b fa f = foldrM f b fa
insertUpdated m c = do insertUpdated m c = do
rc <- resolveGmComponent mumns c rc <- resolveGmComponent (fst <$> mcache) c
return $ Map.insert (gmcName rc) rc m return $ Map.insert (gmcName rc) rc m
same :: Eq b same :: Eq b

View File

@ -210,7 +210,6 @@ data GhcModCaches = GhcModCaches {
data GhcModState = GhcModState { data GhcModState = GhcModState {
gmGhcSession :: !(Maybe GmGhcSession) gmGhcSession :: !(Maybe GmGhcSession)
, gmComponents :: !(Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
, gmCompilerMode :: !CompilerMode , gmCompilerMode :: !CompilerMode
, gmCaches :: !GhcModCaches , gmCaches :: !GhcModCaches
, gmMMappedFiles :: !FileMappingMap , gmMMappedFiles :: !FileMappingMap
@ -220,7 +219,7 @@ data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read)
defaultGhcModState :: GhcModState defaultGhcModState :: GhcModState
defaultGhcModState = defaultGhcModState =
GhcModState n Map.empty Simple (GhcModCaches n n n n) Map.empty GhcModState n Simple (GhcModCaches n n n n) Map.empty
where n = Nothing where n = Nothing
---------------------------------------------------------------- ----------------------------------------------------------------