aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuke Lau <luke_lau@icloud.com>2019-01-20 00:42:00 +0000
committerDaniel Gröber <dxld@darkboxed.org>2019-01-26 02:59:27 +0100
commitf55c951ddaffec1f05e7215017774a80acd6d5e2 (patch)
tree940edaaf114aaaee81484687a06692a9e5c55373
parentec0067142368dbf1ac92f8ba056043d52e41af8b (diff)
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.
-rw-r--r--lib/Distribution/Helper.hs81
-rw-r--r--src/CabalHelper/Compiletime/Program/Stack.hs8
2 files changed, 46 insertions, 43 deletions
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
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 518e7f9..f0dd766 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -117,10 +117,6 @@ workdirArg :: QueryEnvI c 'Stack -> [String]
workdirArg QueryEnv{qeDistDir=DistDirStack mworkdir} =
maybeToList $ ("--work-dir="++) . unRelativePath <$> mworkdir
-patchCompPrograms :: StackProjPaths -> CompPrograms -> CompPrograms
-patchCompPrograms StackProjPaths{sppCompExe} cprogs =
- cprogs { ghcProgram = sppCompExe }
-
doStackCmd :: (QueryEnvI c 'Stack -> CallProcessWithCwd a)
-> QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO a
doStackCmd procfn qe mcwd args =
@@ -132,3 +128,7 @@ callStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO ()
readStackCmd = doStackCmd (\qe -> qeReadProcess qe "")
callStackCmd = doStackCmd qeCallProcess
+
+patchCompPrograms :: StackProjPaths -> CompPrograms -> CompPrograms
+patchCompPrograms StackProjPaths{sppCompExe} cprogs =
+ cprogs { ghcProgram = sppCompExe }