diff --git a/GHCMod.hs b/GHCMod.hs index 8c6e244..2953651 100644 --- a/GHCMod.hs +++ b/GHCMod.hs @@ -20,15 +20,18 @@ import Types ---------------------------------------------------------------- +ghcOptHelp :: String +ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] " + usage :: String usage = "ghc-mod version 1.0.0\n" ++ "Usage:\n" - ++ "\t ghc-mod list [-l]\n" + ++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l]\n" ++ "\t ghc-mod lang [-l]\n" - ++ "\t ghc-mod browse [-l] [-o] [ ...]\n" - ++ "\t ghc-mod check [-g GHC opt1 -g GHC opt2 ...] \n" - ++ "\t ghc-mod type \n" - ++ "\t ghc-mod info \n" + ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [ ...]\n" + ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod info" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod boot\n" ++ "\t ghc-mod help\n" diff --git a/Types.hs b/Types.hs index d45ceee..5fbe6ed 100644 --- a/Types.hs +++ b/Types.hs @@ -29,14 +29,14 @@ withGHC body = ghandle ignore $ runGhc (Just libdir) body initSession0 :: Options -> Ghc [PackageId] initSession0 opt = getSessionDynFlags >>= - setSessionDynFlags . setPackageConfFlags opt + (>>= setSessionDynFlags) . setGhcFlags opt initSession :: Options -> [String] -> [FilePath] -> Bool -> Ghc LogReader initSession opt cmdOpts idirs logging = do dflags <- getSessionDynFlags let opts = map noLoc cmdOpts (dflags',_,_) <- parseDynamicFlags dflags opts - (dflags'',readLog) <- liftIO . setLogger logging . setPackageConfFlags opt . setFlags dflags' $ idirs + (dflags'',readLog) <- liftIO . (>>= setLogger logging) . setGhcFlags opt . setFlags dflags' $ idirs setSessionDynFlags dflags'' return readLog @@ -55,17 +55,10 @@ setFlags d idirs = d' ghcPackage :: PackageFlag ghcPackage = ExposePackage "ghc" -setPackageConfFlags :: Options -> DynFlags -> DynFlags -setPackageConfFlags - Options { packageConfs = confs, useUserPackageConf = useUser } - flagset@DynFlags { extraPkgConfs = extra, flags = origFlags } - = flagset { extraPkgConfs = extra', flags = flags' } - where - extra' = confs ++ extra - flags' = if useUser then - origFlags - else - filter (/=Opt_ReadUserPackageConf) origFlags +setGhcFlags :: Monad m => Options -> DynFlags -> m DynFlags +setGhcFlags opt flagset = + do (flagset',_,_) <- parseDynamicFlags flagset (map noLoc (ghcOpts opt)) + return flagset' ----------------------------------------------------------------