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 module GhcBuild (getBuildFlags, buildPackage) where
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import Control.Monad (when) import Control.Monad (when)
import Data.IORef import Data.IORef
import System.Process (rawSystem) import System.Process (rawSystem)
import System.Environment (getEnvironment)
import CmdLineParser import CmdLineParser
import Data.Char (toLower) import Data.Char (toLower)
import Data.List (isPrefixOf, partition) import Data.List (isPrefixOf, partition)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename, import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
isSourceFilename, startPhase) isSourceFilename, startPhase)
import DriverPipeline (compileFile, link, linkBinary, oneShot) import DriverPipeline (compileFile, link, linkBinary, oneShot)
import DynFlags (DynFlags, compilerInfo) import DynFlags (DynFlags, compilerInfo)
import qualified DynFlags import qualified DynFlags
import qualified GHC import qualified GHC
import GHC.Paths (libdir) import GHC.Paths (libdir)
import HscTypes (HscEnv (..), emptyHomePackageTable) import HscTypes (HscEnv (..), emptyHomePackageTable)
import MonadUtils (liftIO) import MonadUtils (liftIO)
import Panic (ghcError, panic) import Panic (ghcError, panic)
import SrcLoc (Located, mkGeneralLocated) import SrcLoc (Located, mkGeneralLocated)
import StaticFlags (v_Ld_inputs) import StaticFlags (v_Ld_inputs)
import qualified StaticFlags import qualified StaticFlags
import System.FilePath (normalise, (</>)) import System.FilePath (normalise, (</>))
import Util (consIORef, looksLikeModuleName) import Util (consIORef, looksLikeModuleName)
{- {-
This contains a huge hack: This contains a huge hack:
@ -53,7 +54,8 @@ import Util (consIORef, looksLikeModuleName)
getBuildFlags :: IO [Located String] getBuildFlags :: IO [Located String]
getBuildFlags = do getBuildFlags = do
argv0 <- fmap read $ readFile "yesod-devel/ghcargs.txt" -- generated by yesod-ghc-wrapper 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 mbMinusB | null minusB_args = Nothing
| otherwise = Just (drop 2 (last minusB_args)) | otherwise = Just (drop 2 (last minusB_args))
let argv1' = map (mkGeneralLocated "on the commandline") argv1 let argv1' = map (mkGeneralLocated "on the commandline") argv1
@ -61,6 +63,14 @@ getBuildFlags = do
(argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1' (argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1'
return argv2 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 :: [Located String] -> FilePath -> FilePath -> IO Bool
buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do
putStrLn ("exception building package: " ++ show (e :: Ex.SomeException)) putStrLn ("exception building package: " ++ show (e :: Ex.SomeException))
@ -416,4 +426,3 @@ isCompManagerMode DoMake = True
isCompManagerMode DoInteractive = True isCompManagerMode DoInteractive = True
isCompManagerMode (DoEval _) = True isCompManagerMode (DoEval _) = True
isCompManagerMode _ = False isCompManagerMode _ = False

2
yesod/ghcwrapper.hs
View File

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