Merge pull request #489 from dudebout/hsenv-interaction

Hsenv interaction, use correct package database
This commit is contained in:
Luite Stegeman 2013-01-22 20:27:55 -08:00
commit 7a4d42745a
2 changed files with 28 additions and 21 deletions

View File

@ -22,6 +22,7 @@ import qualified Control.Exception as Ex
import Control.Monad (when)
import Data.IORef
import System.Process (rawSystem)
import System.Environment (getEnvironment)
import CmdLineParser
import Data.Char (toLower)
@ -53,7 +54,8 @@ import Util (consIORef, looksLikeModuleName)
getBuildFlags :: IO [Located String]
getBuildFlags = do
argv0 <- fmap read $ readFile "yesod-devel/ghcargs.txt" -- generated by yesod-ghc-wrapper
let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
argv0' <- prependHsenvArgv argv0
let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0'
mbMinusB | null minusB_args = Nothing
| otherwise = Just (drop 2 (last minusB_args))
let argv1' = map (mkGeneralLocated "on the commandline") argv1
@ -61,6 +63,14 @@ getBuildFlags = do
(argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1'
return argv2
prependHsenvArgv :: [String] -> IO [String]
prependHsenvArgv argv = do
env <- getEnvironment
return $ case (lookup "HSENV" env) of
Nothing -> argv
_ -> hsenvArgv ++ argv
where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env)
buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool
buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do
putStrLn ("exception building package: " ++ show (e :: Ex.SomeException))
@ -416,4 +426,3 @@ isCompManagerMode DoMake = True
isCompManagerMode DoInteractive = True
isCompManagerMode (DoEval _) = True
isCompManagerMode _ = False

View File

@ -58,5 +58,3 @@ main = do
when e $ writeFile outFile (show args ++ "\n")
ex <- runProgram cmd args
exitWith ex