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

Detects when hsenv is activated and read the necessary GHC flags.

Browse Source
This commit is contained in:
Nicolas Dudebout 2013-01-18 16:18:51 -05:00
parent 9baadd471c
commit 373ff896b3
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
yesod/GhcBuild.hs
View File

@ -22,6 +22,7 @@ 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)
@ -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' <- addHsenvArgs 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
addHsenvArgs :: [String] -> IO [String]
addHsenvArgs argv = do
env <- getEnvironment
return $ case (lookup "HSENV" env) of
Nothing -> argv
_ -> argv ++ hsenvArgv
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))