aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordavve <davve@dtek.chalmers.se>2006-12-29 18:53:39 +0000
committerdavve <davve@dtek.chalmers.se>2006-12-29 18:53:39 +0000
commit3117dadcff488eba3993fc0a6bf21281a6d75c26 (patch)
tree12479c6615c8665e4a66048a8b3f302738a01cfe /src
parent63dccfcba3743a78a1848b9ccbba1339e2a669c5 (diff)
Automatically get the GHC lib dir
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs50
1 files changed, 34 insertions, 16 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 763be520..ad898c8b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,7 +13,7 @@ import HaddockRename
import HaddockTypes
import HaddockUtil
import HaddockVersion
-import Paths_haddock ( getDataDir )
+import Paths_haddock ( getDataDir, compilerPath )
import Prelude hiding ( catch )
import Control.Exception ( catch )
@@ -22,18 +22,22 @@ import Control.Monad.Writer ( Writer, runWriter, tell )
import Data.Char ( isSpace )
import Data.IORef ( writeIORef )
import Data.List ( nub, nubBy, (\\), foldl', sortBy, foldl1, init,
- mapAccumL, find, isPrefixOf )
+ mapAccumL, find, isPrefixOf ))
import Data.Maybe ( Maybe(..), isJust, isNothing, maybeToList,
listToMaybe, fromJust, catMaybes )
import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..),
ArgDescr(..) )
import System.Environment ( getArgs )
import System.Directory ( doesDirectoryExist )
+import System.FilePath
+import System.Cmd ( system )
+import System.Exit ( ExitCode(..) )
import qualified Data.Map as Map
import Data.Map (Map)
import Distribution.InstalledPackageInfo ( InstalledPackageInfo(..) )
+import Distribution.Simple.Utils ( withTempFile )
import GHC
import Outputable
@@ -55,32 +59,51 @@ import DynFlags hiding ( Option )
import Packages hiding ( package )
import StaticFlags ( parseStaticFlags )
------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
-- Top-level stuff
+--------------------------------------------------------------------------------
+
+getGHCLibDir = do
+ str <- systemCaptureStdout 0 (compilerPath ++ " --print-libdir")
+ case lines str of
+ (path:_) -> return path
+ _ -> die ("Error: " ++ compilerPath ++ " did not respond well to " ++
+ "--print-libdir")
+
+-- temporarily taken from Cabal. TODO: use a library
+systemCaptureStdout :: Int -> String -> IO String
+systemCaptureStdout verbose cmd = do
+ withTempFile "." "" $ \tmp -> do
+ let cmd_line = cmd ++ " >" ++ tmp
+ when (verbose > 0) $ putStrLn cmd_line
+ res <- system cmd_line
+ case res of
+ ExitFailure _ -> die ("executing external program failed: "++cmd_line)
+ ExitSuccess -> do str <- readFile tmp
+ let ev [] = ' '; ev xs = last xs
+ ev str `seq` return str
type CheckedMod = (Module, FilePath, FullyCheckedMod)
main :: IO ()
main = do
-
- -- first, get the GHC library dir (-B option)
args <- getArgs
- (libDir, rest) <- getLibDir args
+ libDir <- getGHCLibDir
-- find out which flag mode we are in
- let (isGHCMode, rest') = parseModeFlag rest
+ let (isGHCMode, rest) = parseModeFlag args
-- initialize GHC
(session, dynflags) <- startGHC libDir
-- parse GHC flags given to the program
- (dynflags', rest'') <- if isGHCMode
- then parseGHCFlags_GHCMode dynflags rest'
- else parseGHCFlags_HaddockMode dynflags rest'
+ (dynflags', rest') <- if isGHCMode
+ then parseGHCFlags_GHCMode dynflags rest
+ else parseGHCFlags_HaddockMode dynflags rest
setSessionDynFlags session dynflags'
-- parse Haddock specific flags
- (flags, fileArgs) <- parseHaddockOpts rest''
+ (flags, fileArgs) <- parseHaddockOpts rest'
-- try to sort and check the input files using the GHC API
modules <- sortAndCheckModules session dynflags' fileArgs
@@ -171,11 +194,6 @@ parseHaddockOpts words =
usageHeader :: String -> String
usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n"
-getLibDir :: [String] -> IO (String, [String])
-getLibDir ("-B":dir:rest) = return (dir, rest)
-getLibDir (('-':'B':dir):rest) | not (null dir) = return (dir, rest)
-getLibDir _ = die "Missing GHC lib dir option: -B <dir>\n"
-
extractGHCFlags :: [Flag] -> [String]
extractGHCFlags flags = [ flag | Flag_GHCFlag flag <- flags ]