diff options
| -rw-r--r-- | src/Haddock/GHC.hs | 42 | ||||
| -rw-r--r-- | src/Haddock/Options.hs | 13 | ||||
| -rw-r--r-- | src/Main.hs | 10 |
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 |