aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <davve@dtek.chalmers.se>2007-10-17 16:02:28 +0000
committerDavid Waern <davve@dtek.chalmers.se>2007-10-17 16:02:28 +0000
commit54d9edbb47657ba67b5b1c5248f295c772bf2948 (patch)
treefa9748b5e4be17caf9ddee153eeec4316de6fc24
parent0f578158c1745bd98f940c2124c3463055a400b6 (diff)
Add --optghc=.. style flag passing to GHC
-rw-r--r--src/Haddock/GHC.hs42
-rw-r--r--src/Haddock/Options.hs13
-rw-r--r--src/Main.hs10
3 files changed, 27 insertions, 38 deletions
diff --git a/src/Haddock/GHC.hs b/src/Haddock/GHC.hs
index b4b9dd3f..8c83912a 100644
--- a/src/Haddock/GHC.hs
+++ b/src/Haddock/GHC.hs
@@ -8,8 +8,6 @@
module Haddock.GHC (
startGhc,
loadPackages,
- tryParseStaticFlags,
- parseGhcFlags,
module Haddock.GHC.Typecheck,
module Haddock.GHC.Utils
) where
@@ -32,18 +30,20 @@ import StaticFlags
-- | Start a GHC session with the -haddock flag set. Also turn off
-- compilation and linking.
-startGhc :: String -> IO (Session, DynFlags)
-startGhc libDir = do
- session <- newSession (Just libDir)
- flags <- getSessionDynFlags session
- let flags' = dopt_set flags Opt_Haddock
- let flags'' = flags' {
+startGhc :: String -> [String] -> IO (Session, DynFlags)
+startGhc libDir flags = do
+ restFlags <- parseStaticFlags flags
+ session <- newSession (Just libDir)
+ dynflags <- getSessionDynFlags session
+ let dynflags' = dopt_set dynflags Opt_Haddock
+ let dynflags'' = dynflags' {
hscTarget = HscNothing,
ghcMode = CompManager,
ghcLink = NoLink
}
- setSessionDynFlags session flags''
- return (session, flags'')
+ dynflags''' <- parseGhcFlags dynflags'' restFlags flags
+ setSessionDynFlags session dynflags'''
+ return (session, dynflags''')
-- | Expose the list of packages to GHC. Then initialize GHC's package state
@@ -88,21 +88,9 @@ loadPackages session pkgStrs = do
handleParse Nothing = throwE "Could not parse package identifier"
--- | Filter out the GHC specific flags and try to parse and set them as static
--- flags. Return a list of flags that couldn't be parsed.
-tryParseStaticFlags flags = do
- let ghcFlags = [ str | Flag_GhcFlag str <- flags ]
- parseStaticFlags ghcFlags
-
-
-- | Try to parse dynamic GHC flags
-parseGhcFlags session ghcFlags = do
- dflags <- getSessionDynFlags session
- foldlM parseFlag dflags (map words ghcFlags)
- where
- -- try to parse a flag as either a dynamic or static GHC flag
- parseFlag dynflags ghcFlag = do
- (dynflags', rest) <- parseDynamicFlags dynflags ghcFlag
- when (rest == ghcFlag) $
- throwE ("Couldn't parse GHC flag: " ++ (unwords ghcFlag))
- return dynflags'
+parseGhcFlags dynflags flags origFlags = do
+ (dynflags', rest) <- parseDynamicFlags dynflags flags
+ if not (null rest)
+ then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))
+ else return dynflags'
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index c330f35e..89850f9c 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -8,7 +8,8 @@
module Haddock.Options (
parseHaddockOpts,
Flag(..),
- getUsage
+ getUsage,
+ makeGhcFlags
) where
@@ -35,6 +36,10 @@ parseHaddockOpts words =
throwE (concat errors ++ usage)
+makeGhcFlags :: [Flag] -> [String]
+makeGhcFlags flags = [ option | Flag_OptGhc option <- flags ]
+
+
data Flag
= Flag_CSS String
| Flag_Debug
@@ -64,7 +69,7 @@ data Flag
| Flag_IgnoreAllExports
| Flag_HideModule String
| Flag_UsePackage String
- | Flag_GhcFlag String
+ | Flag_OptGhc String
| Flag_GhcLibDir String
deriving (Eq)
@@ -131,6 +136,6 @@ options backwardsCompat =
"behave as if MODULE has the hide attribute",
Option [] ["use-package"] (ReqArg Flag_UsePackage "PACKAGE")
"the modules being processed depend on PACKAGE",
- Option ['g'] [] (ReqArg Flag_GhcFlag "FLAGS + ARGS")
- ("send a flag to GHC")
+ Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION")
+ "Forward option to GHC"
]
diff --git a/src/Main.hs b/src/Main.hs
index 980e2023..c900529c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -104,13 +104,9 @@ main = handleTopExceptions $ do
(flags, fileArgs) <- parseHaddockOpts args
libDir <- handleEasyFlags flags fileArgs
- -- initialize GHC
- restGhcFlags <- tryParseStaticFlags flags
- (session, _) <- startGhc libDir
-
- -- parse and set the GHC flags
- dynflags <- parseGhcFlags session restGhcFlags
- setSessionDynFlags session dynflags
+ -- initialize GHC
+ let ghcFlags = makeGhcFlags flags
+ (session, dynflags) <- startGhc libDir ghcFlags
-- get the -use-package packages, load them in GHC,
-- and try to get the corresponding installed HaddockPackages