diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 39 |
1 files changed, 20 insertions, 19 deletions
diff --git a/src/Main.hs b/src/Main.hs index ba48a709..cc5d1302 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -50,7 +50,7 @@ import Data.Int #ifdef IN_GHC_TREE import System.FilePath #else -import GHC.Paths +import qualified GHC.Paths as GhcPaths import Paths_haddock #endif @@ -155,7 +155,7 @@ main = handleTopExceptions $ do readPackagesAndProcessModules :: [Flag] -> [String] -> IO ([(DocPaths, InterfaceFile)], [Interface], LinkEnv) readPackagesAndProcessModules flags files = do - libDir <- getGhcLibDir flags + libDir <- fmap snd (getGhcDirs flags) -- Catches all GHC source errors, then prints and re-throws them. let handleSrcErrors action' = flip handleSourceError action' $ \err -> do @@ -329,23 +329,24 @@ getHaddockLibDir flags = case [str | Flag_Lib str <- flags] of [] -> #ifdef IN_GHC_TREE - getInTreeLibDir + fmap snd getInTreeDirs #else getDataDir -- provided by Cabal #endif fs -> return (last fs) -getGhcLibDir :: [Flag] -> IO String -getGhcLibDir flags = - case [ dir | Flag_GhcLibDir dir <- flags ] of - [] -> +getGhcDirs :: [Flag] -> IO (String, String) +getGhcDirs flags = do + (ghcPath, libDir) <- #ifdef IN_GHC_TREE - getInTreeLibDir + getInTreeDirs #else - return libdir -- from GHC.Paths + return (GhcPaths.ghc, GhcPaths.libdir) #endif - xs -> return $ last xs + case [ dir | Flag_GhcLibDir dir <- flags ] of + [] -> return (ghcPath, libDir) + xs -> return (ghcPath, last xs) shortcutFlags :: [Flag] -> IO () @@ -356,8 +357,12 @@ shortcutFlags flags = do when (Flag_Version `elem` flags) byeVersion when (Flag_GhcVersion `elem` flags) byeGhcVersion + when (Flag_PrintGhcPath `elem` flags) $ do + dir <- fmap fst (getGhcDirs flags) + bye $ dir ++ "\n" + when (Flag_PrintGhcLibDir `elem` flags) $ do - dir <- getGhcLibDir flags + dir <- fmap snd (getGhcDirs flags) bye $ dir ++ "\n" when (Flag_UseUnicode `elem` flags && Flag_Html `notElem` flags) $ @@ -404,16 +409,12 @@ getPrologue flags = #ifdef IN_GHC_TREE -getInTreeLibDir :: IO String -getInTreeLibDir = do +getInTreeDirs :: IO (String, String) +getInTreeDirs = do m <- getExecDir case m of - Nothing -> error "No GhcLibDir found" -#ifdef NEW_GHC_LAYOUT - Just d -> return (d </> ".." </> "lib") -#else - Just d -> return (d </> "..") -#endif + Nothing -> error "No GhcDir found" + Just d -> let p = d </> ".." in return (p </> "bin" </> "ghc", p </> "lib") getExecDir :: IO (Maybe String) |