diff options
Diffstat (limited to 'src')
| -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 | 
