Fix caching for getGhcPkgOptions
This commit is contained in:
parent
8b8f947b5e
commit
c45a7f4b52
@ -38,11 +38,9 @@ import Paths_ghc_mod as GhcMod
|
|||||||
|
|
||||||
-- | Only package related GHC options, sufficient for things that don't need to
|
-- | Only package related GHC options, sufficient for things that don't need to
|
||||||
-- access home modules
|
-- access home modules
|
||||||
getGhcPkgOptions :: (MonadIO m, GmEnv m) => m [(ChComponentName, [GHCOption])]
|
getGhcPkgOptions :: (MonadIO m, GmEnv m, GmLog m)
|
||||||
getGhcPkgOptions = do
|
=> m [(ChComponentName, [GHCOption])]
|
||||||
Cradle {..} <- cradle
|
getGhcPkgOptions = map (\c -> (gmcName c, gmcGhcPkgOpts c)) `liftM` getComponents
|
||||||
let distdir = cradleRootDir </> "dist"
|
|
||||||
runQuery distdir ghcPkgOptions
|
|
||||||
|
|
||||||
helperProgs :: Options -> Programs
|
helperProgs :: Options -> Programs
|
||||||
helperProgs opts = Programs {
|
helperProgs opts = Programs {
|
||||||
@ -76,18 +74,25 @@ cabalHelperCache = Cached {
|
|||||||
cacheFile = cabalHelperCacheFile,
|
cacheFile = cabalHelperCacheFile,
|
||||||
cachedAction = \ _ (progs, root, _) _ ->
|
cachedAction = \ _ (progs, root, _) _ ->
|
||||||
runQuery' progs root $ do
|
runQuery' progs root $ do
|
||||||
q <- liftM5 join5
|
q <- liftM7 join7
|
||||||
ghcOptions
|
ghcOptions
|
||||||
|
ghcPkgOptions
|
||||||
ghcSrcOptions
|
ghcSrcOptions
|
||||||
ghcLangOptions
|
ghcLangOptions
|
||||||
entrypoints
|
entrypoints
|
||||||
|
entrypoints
|
||||||
sourceDirs
|
sourceDirs
|
||||||
let cs = flip map q $ \(cn, (opts, (srcOpts, (langOpts, (ep, srcDirs))))) ->
|
let cs = flip map q $ curry8 (GmComponent mempty)
|
||||||
GmComponent cn opts srcOpts langOpts ep ep srcDirs mempty
|
|
||||||
return ([setupConfigPath], cs)
|
return ([setupConfigPath], cs)
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
join5 a b c d = join' a . join' b . join' c . join' d
|
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
|
||||||
|
|
||||||
|
liftM7 fn ma mb mc md me mf mg = do
|
||||||
|
a <- ma; b <- mb; c <- mc; d <- md; e <- me; f <- mf; g <- mg
|
||||||
|
return (fn a b c d e f g)
|
||||||
|
|
||||||
|
join7 a b c d e f = join' a . join' b . join' c . join' d . join' e . join' f
|
||||||
join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]
|
join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]
|
||||||
join' lb lc = [ (a, (b, c))
|
join' lb lc = [ (a, (b, c))
|
||||||
| (a, b) <- lb
|
| (a, b) <- lb
|
||||||
@ -95,7 +100,6 @@ cabalHelperCache = Cached {
|
|||||||
, a == a'
|
, a == a'
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
withCabal :: (MonadIO m, GmEnv m) => m a -> m a
|
withCabal :: (MonadIO m, GmEnv m) => m a -> m a
|
||||||
withCabal action = do
|
withCabal action = do
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
|
@ -14,7 +14,7 @@ import qualified GHC as G
|
|||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- | Listing installed modules.
|
-- | Listing installed modules.
|
||||||
modules :: (IOish m, GmEnv m) => m String
|
modules :: (IOish m, GmEnv m, GmLog m) => m String
|
||||||
modules = do
|
modules = do
|
||||||
Options { detailed } <- options
|
Options { detailed } <- options
|
||||||
df <- runGmPkgGhc G.getSessionDynFlags
|
df <- runGmPkgGhc G.getSessionDynFlags
|
||||||
|
@ -82,7 +82,7 @@ runLightGhc env action = do
|
|||||||
renv <- newIORef env
|
renv <- newIORef env
|
||||||
flip runReaderT renv $ unLightGhc action
|
flip runReaderT renv $ unLightGhc action
|
||||||
|
|
||||||
runGmPkgGhc :: (IOish m, GmEnv m) => LightGhc a -> m a
|
runGmPkgGhc :: (IOish m, GmEnv m, GmLog m) => LightGhc a -> m a
|
||||||
runGmPkgGhc action = do
|
runGmPkgGhc action = do
|
||||||
pkgOpts <- packageGhcOptions
|
pkgOpts <- packageGhcOptions
|
||||||
withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action
|
withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action
|
||||||
@ -258,7 +258,7 @@ findCandidates scns = foldl1 Set.intersection scns
|
|||||||
pickComponent :: Set ChComponentName -> ChComponentName
|
pickComponent :: Set ChComponentName -> ChComponentName
|
||||||
pickComponent scn = Set.findMin scn
|
pickComponent scn = Set.findMin scn
|
||||||
|
|
||||||
packageGhcOptions :: (MonadIO m, GmEnv m) => m [GHCOption]
|
packageGhcOptions :: (MonadIO m, GmEnv m, GmLog m) => m [GHCOption]
|
||||||
packageGhcOptions = do
|
packageGhcOptions = do
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
case cradleCabalFile crdl of
|
case cradleCabalFile crdl of
|
||||||
|
@ -210,14 +210,15 @@ instance Monoid GmModuleGraph where
|
|||||||
data GmComponentType = GMCRaw
|
data GmComponentType = GMCRaw
|
||||||
| GMCResolved
|
| GMCResolved
|
||||||
data GmComponent (t :: GmComponentType) eps = GmComponent {
|
data GmComponent (t :: GmComponentType) eps = GmComponent {
|
||||||
|
gmcHomeModuleGraph :: GmModuleGraph,
|
||||||
gmcName :: ChComponentName,
|
gmcName :: ChComponentName,
|
||||||
gmcGhcOpts :: [GHCOption],
|
gmcGhcOpts :: [GHCOption],
|
||||||
|
gmcGhcPkgOpts :: [GHCOption],
|
||||||
gmcGhcSrcOpts :: [GHCOption],
|
gmcGhcSrcOpts :: [GHCOption],
|
||||||
gmcGhcLangOpts :: [GHCOption],
|
gmcGhcLangOpts :: [GHCOption],
|
||||||
gmcRawEntrypoints :: ChEntrypoint,
|
gmcRawEntrypoints :: ChEntrypoint,
|
||||||
gmcEntrypoints :: eps,
|
gmcEntrypoints :: eps,
|
||||||
gmcSourceDirs :: [FilePath],
|
gmcSourceDirs :: [FilePath]
|
||||||
gmcHomeModuleGraph :: GmModuleGraph
|
|
||||||
} deriving (Eq, Ord, Show, Read, Generic, Functor)
|
} deriving (Eq, Ord, Show, Read, Generic, Functor)
|
||||||
|
|
||||||
instance Serialize eps => Serialize (GmComponent t eps)
|
instance Serialize eps => Serialize (GmComponent t eps)
|
||||||
|
Loading…
Reference in New Issue
Block a user