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:
parent
a12a7fabc0
commit
4963b782d9
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user