From f55c951ddaffec1f05e7215017774a80acd6d5e2 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 20 Jan 2019 00:42:00 +0000 Subject: Fix getHelperExe not using correct stack programs In turn fixes errors when building cabal-helper exe for stack projects where the resolver uses a different ghc version than system. --- lib/Distribution/Helper.hs | 81 ++++++++++++++++++++++++---------------------- 1 file changed, 42 insertions(+), 39 deletions(-) (limited to 'lib/Distribution') diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 4952b2e..664ff01 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -457,22 +457,15 @@ readProjInfo qe pc pcm = withVerbosity $ do Just cabal_files <- NonEmpty.nonEmpty <$> Stack.listPackageCabalFiles qe units <- mapM (Stack.getUnit qe) cabal_files proj_paths <- Stack.projPaths qe - cprogs <- - guessCompProgramPaths $ - Stack.patchCompPrograms proj_paths $ - qeCompPrograms qe - Just (cabalVer:_) <- runMaybeT $ - let ?cprogs = cprogs in - let ?progs = qePrograms qe in + let piImpl = ProjInfoStack { piStackProjPaths = proj_paths } + Just (cabalVer:_) <- withProgs piImpl qe $ runMaybeT $ GHC.listCabalVersions (Just (sppGlobalPkgDb proj_paths)) -- ^ See [Note Stack Cabal Version] return ProjInfo { piCabalVersion = cabalVer , piProjConfModTimes = pcm , piUnits = units - , piImpl = ProjInfoStack - { piStackProjPaths = proj_paths - } + , .. } readUnitInfo :: QueryEnvI c pt -> FilePath -> Unit pt -> IO UnitInfo @@ -573,33 +566,6 @@ buildPlatform = display Distribution.System.buildPlatform lookupEnv' :: String -> IO (Maybe String) lookupEnv' k = lookup k <$> getEnvironment --- | Determine ghc-pkg path from ghc path -guessCompProgramPaths :: Verbose => CompPrograms -> IO CompPrograms -guessCompProgramPaths progs = do - let v | ?verbose = deafening - | otherwise = silent - mGhcPath0 | same ghcProgram progs dprogs = Nothing - | otherwise = Just $ ghcProgram progs - mGhcPkgPath0 | same ghcPkgProgram progs dprogs = Nothing - | otherwise = Just $ ghcPkgProgram progs - (_compiler, _mplatform, progdb) - <- GHC.configure - v - mGhcPath0 - mGhcPkgPath0 - ProgDb.defaultProgramDb - let getProg p = ProgDb.programPath <$> ProgDb.lookupProgram p progdb - mghcPath1 = getProg ProgDb.ghcProgram - mghcPkgPath1 = getProg ProgDb.ghcPkgProgram - return progs - { ghcProgram = fromMaybe (ghcProgram progs) mghcPath1 - , ghcPkgProgram = fromMaybe (ghcProgram progs) mghcPkgPath1 - } - - where - same f o o' = f o == f o' - dprogs = defaultCompPrograms - withVerbosity :: (Verbose => IO a) -> IO a withVerbosity act = do x <- lookup "CABAL_HELPER_DEBUG" <$> getEnvironment @@ -609,10 +575,47 @@ withVerbosity act = do _ -> False act +-- | Bring 'Programs' and 'CompPrograms' into scope as implicit parameters +withProgs + :: Verbose => ProjInfoImpl pt -> QueryEnvI c pt -> (Env => IO a) -> IO a +withProgs impl QueryEnv{..} f = do + cprogs <- guessCompProgramPaths $ case impl of + ProjInfoStack projPaths -> + Stack.patchCompPrograms projPaths qeCompPrograms + _ -> qeCompPrograms + let ?cprogs = cprogs in + let ?progs = qePrograms in f + where + -- | Determine ghc-pkg path from ghc path + guessCompProgramPaths :: Verbose => CompPrograms -> IO CompPrograms + guessCompProgramPaths progs = do + let v | ?verbose = deafening + | otherwise = silent + mGhcPath0 | same ghcProgram progs dprogs = Nothing + | otherwise = Just $ ghcProgram progs + mGhcPkgPath0 | same ghcPkgProgram progs dprogs = Nothing + | otherwise = Just $ ghcPkgProgram progs + (_compiler, _mplatform, progdb) + <- GHC.configure + v + mGhcPath0 + mGhcPkgPath0 + ProgDb.defaultProgramDb + let getProg p = ProgDb.programPath <$> ProgDb.lookupProgram p progdb + mghcPath1 = getProg ProgDb.ghcProgram + mghcPkgPath1 = getProg ProgDb.ghcPkgProgram + return progs + { ghcProgram = fromMaybe (ghcProgram progs) mghcPath1 + , ghcPkgProgram = fromMaybe (ghcProgram progs) mghcPkgPath1 + } + where + same f o o' = f o == f o' + dprogs = defaultCompPrograms + getHelperExe :: ProjInfo pt -> QueryEnvI c pt -> IO FilePath -getHelperExe proj_info QueryEnv{..} = do - withVerbosity $ do +getHelperExe proj_info qe@QueryEnv{..} = do + withVerbosity $ withProgs (piImpl proj_info) qe $ do let comp = wrapper' qeProjLoc qeDistDir proj_info let ?progs = qePrograms ?cprogs = qeCompPrograms -- cgit v1.2.3