- progName <- getProgName
- let usageString =
- "Usage: " ++ progName ++ " [OPTION...] [-- GHC OPTION... --] [files...]"
- args <- getArgs
- let (ghcArgs, ourArgs, unbalanced) = splitArgs args
- let (flags, filenames, errs) = getOpt Permute options ourArgs
- let (hsfiles, otherfiles) = List.partition isHaskellSrcFilename filenames
- let ghc_topdir = case [ d | FlagTopDir d <- flags ] of
- [] -> ""
- (x:_) -> x
- mapM_ (\n -> putStr $ "Warning: ignoring non-Haskellish file " ++ n ++ "\n")
- otherfiles
- if unbalanced || errs /= [] || elem FlagHelp flags || hsfiles == []
- then do
- putStr $ unlines errs
- putStr $ usageInfo usageString options
- exitWith (ExitFailure 1)
- else return ()
-
- let modes = getMode flags
- let openFileMode = if elem FlagAppend flags
- then AppendMode
- else WriteMode
- ctags_hdl <- if CTags `elem` modes
- then Just `liftM` openFile "tags" openFileMode
- else return Nothing
- etags_hdl <- if ETags `elem` modes
- then Just `liftM` openFile "TAGS" openFileMode
- else return Nothing
-
- GHC.defaultErrorHandler defaultDynFlags $
- runGhc (Just ghc_topdir) $ do
- dflags <- getSessionDynFlags
- (pflags, _, _) <- parseDynamicFlags dflags{ verbosity=1 } (map noLoc ghcArgs)
- let dflags2 = pflags { hscTarget = HscNothing } -- don't generate anything
- GHC.defaultCleanupHandler dflags2 $ do
+ progName <- getProgName
+ let usageString =
+ "Usage: " ++ progName ++ " [OPTION...] [-- GHC OPTION... --] [files...]"
+ args <- getArgs
+ let (ghcArgs', ourArgs, unbalanced) = splitArgs args
+ let (flags, filenames, errs) = getOpt Permute options ourArgs
+ let (hsfiles, otherfiles) = List.partition isHaskellSrcFilename filenames
+
+ let ghc_topdir = case [ d | FlagTopDir d <- flags ] of
+ [] -> ""
+ (x:_) -> x
+ mapM_ (\n -> putStr $ "Warning: ignoring non-Haskellish file " ++ n ++ "\n")
+ otherfiles
+ if unbalanced || errs /= [] || elem FlagHelp flags || hsfiles == []
+ then do
+ putStr $ unlines errs
+ putStr $ usageInfo usageString options
+ exitWith (ExitFailure 1)
+ else return ()
+
+ ghcArgs <- case [ d | FlagUseCabalConfig d <- flags ] of
+ [distPref] -> do
+ cabalOpts <- flagsFromCabal distPref
+ return (ghcArgs' ++ cabalOpts)
+ [] ->
+ return ghcArgs'
+ _ -> error "Too many --use-cabal-config flags"
+ print ghcArgs
+
+ let modes = getMode flags
+ let openFileMode = if elem FlagAppend flags
+ then AppendMode
+ else WriteMode
+ ctags_hdl <- if CTags `elem` modes
+ then Just `liftM` openFile "tags" openFileMode
+ else return Nothing
+ etags_hdl <- if ETags `elem` modes
+ then Just `liftM` openFile "TAGS" openFileMode
+ else return Nothing
+
+ GHC.defaultErrorHandler defaultDynFlags $
+ runGhc (Just ghc_topdir) $ do
+ --liftIO $ print "starting up session"
+ dflags <- getSessionDynFlags
+ (pflags, unrec, warns) <- parseDynamicFlags dflags{ verbosity=1 }
+ (map noLoc ghcArgs)
+ unless (null unrec) $
+ liftIO $ putStrLn $ "Unrecognised options:\n" ++ show (map unLoc unrec)
+ liftIO $ mapM_ putStrLn (map unLoc warns)
+ let dflags2 = pflags { hscTarget = HscNothing } -- don't generate anything
+ -- liftIO $ print ("pkgDB", case (pkgDatabase dflags2) of Nothing -> 0
+ -- Just m -> sizeUFM m)
+ setSessionDynFlags dflags2
+ --liftIO $ print (length pkgs)
+
+ GHC.defaultCleanupHandler dflags2 $ do