Remove Haddock.GHC and move its (small) contents to Main

2 files changed, 52 insertions, 116 deletions

diff --git a/src/Haddock/GHC.hs b/src/Haddock/GHC.hs
deleted file mode 100644
index c7ef9b88..00000000
--- a/src/Haddock/GHC.hs
+++ /dev/null
@@ -1,115 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2003
---
-
-
-module Haddock.GHC (
-  startGhc,
-  module Haddock.GhcUtils
-) where
-
-
-import Haddock.GhcUtils
-import Haddock.Exception
-
-import Data.Maybe
-import Control.Monad
-
-import GHC hiding (flags)
-import DynFlags hiding (Option, flags)
-import SrcLoc
-
-
--- | Start a GHC session with the -haddock flag set. Also turn off 
--- compilation and linking.  
-#if __GLASGOW_HASKELL__ >= 609 
-startGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
-startGhc libDir flags ghcActs = do
-  -- TODO: handle warnings?
-  (restFlags, _) <- parseStaticFlags (map noLoc flags)
-  runGhc (Just libDir) $ do
-    dynflags  <- getSessionDynFlags
-#else
-startGhc :: String -> [String] -> IO (Session, DynFlags)
-startGhc libDir flags = do
-  restFlags <- parseStaticFlags flags
-  session <- newSession (Just libDir)
-  dynflags <- getSessionDynFlags session
-  do
-#endif
-    let dynflags' = dopt_set dynflags Opt_Haddock
-    let dynflags'' = dynflags' {
-        hscTarget = HscNothing,
-        ghcMode   = CompManager,
-        ghcLink   = NoLink
-      }
-    dynflags''' <- parseGhcFlags dynflags'' restFlags flags
-    defaultCleanupHandler dynflags''' $ do
-#if __GLASGOW_HASKELL__ >= 609
-        setSessionDynFlags dynflags'''
-        ghcActs dynflags'''
-#else
-        setSessionDynFlags session dynflags'''
-        return (session, dynflags''')
-#endif
-
-
--- | Expose the list of packages to GHC. Then initialize GHC's package state
--- and get the name of the actually loaded packages matching the supplied 
--- list of packages. The matching packages might be newer versions of the 
--- supplied ones. For each matching package, return its InstalledPackageInfo. 
-
--- Commented out, since it is unused and doesn't build with GHC >= 6.9
-{-
-loadPackages :: Session -> [String] -> IO [InstalledPackageInfo]
-
--- It would be better to try to get the "in scope" packages from GHC instead.
--- This would make the -use-package flag unnecessary. But currently it 
--- seems all you can get from the GHC api is all packages that are linked in 
--- (i.e the closure of the "in scope" packages).
-
-loadPackages session pkgStrs = do
-
-  -- expose the packages 
-
-  dfs <- getSessionDynFlags session
-  let dfs' = dfs { packageFlags = packageFlags dfs ++ map ExposePackage pkgStrs }
-  setSessionDynFlags session dfs'
-
-  -- try to parse the packages and get their names, without versions
-  pkgNames <- mapM (handleParse . unpackPackageId . stringToPackageId) pkgStrs
-
-  -- init GHC's package state
-  (dfs'', depPackages) <- initPackages dfs'
-
-  -- compute the pkgIds of the loaded packages matching the 
-  -- supplied ones
-  
-  let depPkgs = map (fromJust . unpackPackageId) depPackages      
-      matchingPackages = [ mkPackageId pkg | pkg <- depPkgs, 
-                           pkgName pkg `elem` pkgNames ]
-
-  -- get InstalledPackageInfos for each package
-  let pkgInfos = map (getPackageDetails (pkgState dfs'')) matchingPackages
-
-  return pkgInfos
-  where
-    handleParse (Just pkg) = return (pkgName pkg)
-    handleParse Nothing = throwE "Could not parse package identifier"
--}
-
--- | Try to parse dynamic GHC flags
-parseGhcFlags :: Monad m => DynFlags -> [Located String]
-              -> [String] -> m DynFlags
-parseGhcFlags dynflags flags origFlags = do
-  -- TODO: handle warnings?
-#if __GLASGOW_HASKELL__ >= 609
-  (dynflags', rest, _) <- parseDynamicFlags dynflags flags
-#else
-  (dynflags', rest) <- parseDynamicFlags dynflags flags
-#endif
-  if not (null rest)
-    then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))
-    else return dynflags'
diff --git a/src/Main.hs b/src/Main.hs
index f80e118b..c97a5b0a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,8 +21,8 @@ import Haddock.Version
 import Haddock.InterfaceFile
 import Haddock.Exception
 import Haddock.Options
-import Haddock.GHC
 import Haddock.Utils
+import Haddock.GhcUtils
 import Paths_haddock
 
 import Control.Monad
@@ -346,6 +346,57 @@ dumpInterfaceFile ifaces homeLinks flags =
 
 
 -------------------------------------------------------------------------------
+-- Creating a GHC session
+-------------------------------------------------------------------------------
+
+-- | Start a GHC session with the -haddock flag set. Also turn off 
+-- compilation and linking.  
+#if __GLASGOW_HASKELL__ >= 609 
+startGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
+startGhc libDir flags ghcActs = do
+  -- TODO: handle warnings?
+  (restFlags, _) <- parseStaticFlags (map noLoc flags)
+  runGhc (Just libDir) $ do
+    dynflags  <- getSessionDynFlags
+#else
+startGhc :: String -> [String] -> IO (Session, DynFlags)
+startGhc libDir flags = do
+  restFlags <- parseStaticFlags flags
+  session <- newSession (Just libDir)
+  dynflags <- getSessionDynFlags session
+  do
+#endif
+    let dynflags' = dopt_set dynflags Opt_Haddock
+    let dynflags'' = dynflags' {
+        hscTarget = HscNothing,
+        ghcMode   = CompManager,
+        ghcLink   = NoLink
+      }
+    dynflags''' <- parseGhcFlags dynflags'' restFlags flags
+    defaultCleanupHandler dynflags''' $ do
+#if __GLASGOW_HASKELL__ >= 609
+        setSessionDynFlags dynflags'''
+        ghcActs dynflags'''
+#else
+        setSessionDynFlags session dynflags'''
+        return (session, dynflags''')
+#endif
+  where
+    parseGhcFlags :: Monad m => DynFlags -> [Located String]
+                  -> [String] -> m DynFlags
+    parseGhcFlags dynflags flags_ origFlags = do
+      -- TODO: handle warnings?
+#if __GLASGOW_HASKELL__ >= 609
+      (dynflags', rest, _) <- parseDynamicFlags dynflags flags_
+#else
+      (dynflags', rest) <- parseDynamicFlags dynflags flags_
+#endif
+      if not (null rest)
+        then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))
+        else return dynflags'
+
+
+-------------------------------------------------------------------------------
 -- Misc
 -------------------------------------------------------------------------------