hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Sync with cabal-helper master

Browse Source
This commit is contained in:
Remous-Aris Koutsiamanis 2017-12-23 16:37:41 +02:00 committed by Daniel Gröber
parent 91a2788328
commit 9ce1cb7db6
2 changed files with 14 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
core/GhcMod/CabalHelper.hs
View File

@ -89,28 +89,17 @@ getComponents = chCached $ \distdir -> Cached {
cacheLens = Just (lGmcComponents . lGmCaches), cacheLens = Just (lGmcComponents . lGmCaches),
cacheFile = cabalHelperCacheFile distdir, cacheFile = cabalHelperCacheFile distdir,
cachedAction = \ _tcf (_progs, _projdir, _ver) _ma -> do cachedAction = \ _tcf (_progs, _projdir, _ver) _ma -> do
runCHQuery $ do cs <- runCHQuery $ components $
q <- join7 GmComponent mempty
<$> ghcOptions CH.<$> ghcOptions
<*> ghcPkgOptions CH.<.> ghcPkgOptions
<*> ghcSrcOptions CH.<.> ghcSrcOptions
<*> ghcLangOptions CH.<.> ghcLangOptions
<*> entrypoints CH.<.> entrypoints
<*> entrypoints CH.<.> entrypoints
<*> sourceDirs CH.<.> sourceDirs
let cs = flip map q $ curry8 (GmComponent mempty)
return ([setupConfigPath distdir], cs) return ([setupConfigPath distdir], cs)
} }
where
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
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' lb lc = [ (a, (b, c))
| (a, b) <- lb
, (a', c) <- lc
, a == a'
]
getQueryEnv :: (IOish m, GmOut m, GmEnv m) => m QueryEnv getQueryEnv :: (IOish m, GmOut m, GmEnv m) => m QueryEnv
getQueryEnv = do getQueryEnv = do
@ -119,7 +108,7 @@ getQueryEnv = do
readProc <- gmReadProcess readProc <- gmReadProcess
let projdir = cradleRootDir crdl let projdir = cradleRootDir crdl
distdir = projdir </> cradleDistDir crdl distdir = projdir </> cradleDistDir crdl
return (defaultQueryEnv projdir distdir) { return (mkQueryEnv projdir distdir) {
qeReadProcess = readProc qeReadProcess = readProc
, qePrograms = helperProgs progs , qePrograms = helperProgs progs
} }
@ -134,7 +123,7 @@ prepareCabalHelper :: (IOish m, GmEnv m, GmOut m, GmLog m) => m ()
prepareCabalHelper = do prepareCabalHelper = do
crdl <- cradle crdl <- cradle
when (isCabalHelperProject $ cradleProject crdl) $ when (isCabalHelperProject $ cradleProject crdl) $
withCabal $ prepare' =<< getQueryEnv withCabal $ prepare =<< getQueryEnv
withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
withAutogen action = do withAutogen action = do
@ -158,7 +147,7 @@ withAutogen action = do
where where
writeAutogen = do writeAutogen = do
gmLog GmDebug "" $ strDoc $ "writing Cabal autogen files" gmLog GmDebug "" $ strDoc $ "writing Cabal autogen files"
writeAutogenFiles' =<< getQueryEnv writeAutogenFiles =<< getQueryEnv
withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a

2
core/GhcMod/Types.hs
View File

@ -284,7 +284,6 @@ data GmComponentType = GMCRaw
| GMCResolved | GMCResolved
data GmComponent (t :: GmComponentType) eps = GmComponent { data GmComponent (t :: GmComponentType) eps = GmComponent {
gmcHomeModuleGraph :: GmModuleGraph gmcHomeModuleGraph :: GmModuleGraph
, gmcName :: ChComponentName
, gmcGhcOpts :: [GHCOption] , gmcGhcOpts :: [GHCOption]
, gmcGhcPkgOpts :: [GHCOption] , gmcGhcPkgOpts :: [GHCOption]
, gmcGhcSrcOpts :: [GHCOption] , gmcGhcSrcOpts :: [GHCOption]
@ -292,6 +291,7 @@ data GmComponent (t :: GmComponentType) eps = GmComponent {
, gmcRawEntrypoints :: ChEntrypoint , gmcRawEntrypoints :: ChEntrypoint
, gmcEntrypoints :: eps , gmcEntrypoints :: eps
, gmcSourceDirs :: [FilePath] , gmcSourceDirs :: [FilePath]
, gmcName :: ChComponentName
} deriving (Eq, Ord, Show, Read, Generic, Functor) } deriving (Eq, Ord, Show, Read, Generic, Functor)
instance Binary eps => Binary (GmComponent t eps) where instance Binary eps => Binary (GmComponent t eps) where