haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #489 from dudebout/hsenv-interaction

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
yesod/GhcBuild.hs
View File

@ -19,29 +19,30 @@
module GhcBuild (getBuildFlags, buildPackage) where
import qualified Control.Exception as Ex
import Control.Monad (when)
import Control.Monad (when)
import Data.IORef
import System.Process (rawSystem)
import System.Process (rawSystem)
import System.Environment (getEnvironment)
import CmdLineParser
import Data.Char (toLower)
import Data.List (isPrefixOf, partition)
import Data.Maybe (fromMaybe)
import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
isSourceFilename, startPhase)
import DriverPipeline (compileFile, link, linkBinary, oneShot)
import DynFlags (DynFlags, compilerInfo)
import Data.Char (toLower)
import Data.List (isPrefixOf, partition)
import Data.Maybe (fromMaybe)
import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
isSourceFilename, startPhase)
import DriverPipeline (compileFile, link, linkBinary, oneShot)
import DynFlags (DynFlags, compilerInfo)
import qualified DynFlags
import qualified GHC
import GHC.Paths (libdir)
import HscTypes (HscEnv (..), emptyHomePackageTable)
import MonadUtils (liftIO)
import Panic (ghcError, panic)
import SrcLoc (Located, mkGeneralLocated)
import StaticFlags (v_Ld_inputs)
import GHC.Paths (libdir)
import HscTypes (HscEnv (..), emptyHomePackageTable)
import MonadUtils (liftIO)
import Panic (ghcError, panic)
import SrcLoc (Located, mkGeneralLocated)
import StaticFlags (v_Ld_inputs)
import qualified StaticFlags
import System.FilePath (normalise, (</>))
import Util (consIORef, looksLikeModuleName)
import System.FilePath (normalise, (</>))
import Util (consIORef, looksLikeModuleName)
{-
This contains a huge hack:
@ -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

2
yesod/ghcwrapper.hs
View File

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