diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 81 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/Stack.hs | 8 |
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 } |