diff options
author | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 22:41:01 +0000 |
---|---|---|
committer | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 22:41:01 +0000 |
commit | d3d25c5d0729c0b64d746e24a855236f6e6a5663 (patch) | |
tree | 8983d4d9645175b8720df5665b7214e5c44b0a2a | |
parent | f53f0f5ff6e43071a38675ac3d3ecc266b9baeee (diff) |
move get*LibDir code in Main.hs, to +consistent code, -duplication
-rw-r--r-- | src/Main.hs | 48 |
1 files changed, 25 insertions, 23 deletions
diff --git a/src/Main.hs b/src/Main.hs index 9e73d4c0..1c6c9d39 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -187,21 +187,7 @@ render flags ifaces installedIfaces = do ,listToMaybe [str | Flag_WikiModuleURL str <- flags] ,listToMaybe [str | Flag_WikiEntityURL str <- flags]) - libDir <- case [str | Flag_Lib str <- flags] of - [] -> -#ifdef IN_GHC_TREE - do m <- getExecDir - case m of - Nothing -> error "No libdir found" -#ifdef NEW_GHC_LAYOUT - Just d -> return (d </> ".." </> "lib") -#else - Just d -> return (d </> "..") -#endif -#else - getDataDir -- provided by Cabal -#endif - fs -> return (last fs) + libDir <- getHaddockLibDir flags let unicode = Flag_UseUnicode `elem` flags let css_file = case [str | Flag_CSS str <- flags] of [] -> Nothing @@ -345,20 +331,23 @@ startGhc libDir flags ghcActs = do -- Misc ------------------------------------------------------------------------------- +getHaddockLibDir :: [Flag] -> IO String +getHaddockLibDir flags = do + case [str | Flag_Lib str <- flags] of + [] -> +#ifdef IN_GHC_TREE + getInTreeLibDir +#else + getDataDir -- provided by Cabal +#endif + fs -> return (last fs) getGhcLibDir :: [Flag] -> IO String getGhcLibDir flags = do case [ dir | Flag_GhcLibDir dir <- flags ] of [] -> #ifdef IN_GHC_TREE - 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 + getInTreeLibDir #else return libdir -- from GHC.Paths #endif @@ -421,6 +410,18 @@ getPrologue flags = #ifdef IN_GHC_TREE + +getInTreeLibDir :: IO String +getInTreeLibDir = + 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 + getExecDir :: IO (Maybe String) #if defined(mingw32_HOST_OS) getExecDir = allocaArray len $ \buf -> do @@ -436,5 +437,6 @@ foreign import stdcall unsafe "GetModuleFileNameA" #else getExecDir = return Nothing #endif + #endif |