diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/GHC.hs | 115 | ||||
| -rw-r--r-- | src/Main.hs | 53 |
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 ------------------------------------------------------------------------------- |