From d3d25c5d0729c0b64d746e24a855236f6e6a5663 Mon Sep 17 00:00:00 2001
From: Isaac Dupree <id@isaac.cedarswampstudios.org>
Date: Sun, 23 Aug 2009 22:41:01 +0000
Subject: move get*LibDir code in Main.hs, to +consistent code, -duplication

---
 src/Main.hs | 48 +++++++++++++++++++++++++-----------------------
 1 file changed, 25 insertions(+), 23 deletions(-)

(limited to 'src')

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
 
-- 
cgit v1.2.3