diff options
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | haddock.cabal | 12 | ||||
| -rw-r--r-- | src/Main.hs | 43 |
3 files changed, 48 insertions, 11 deletions
@@ -1,8 +1,8 @@ TOP=../.. ENABLE_SHELL_WRAPPERS = YES -EXTRA_INPLACE_CONFIGURE_FLAGS += --flags=-ghc-paths -EXTRA_STAGE2_CONFIGURE_FLAGS += --flags=-ghc-paths +EXTRA_INPLACE_CONFIGURE_FLAGS += --flags=in-ghc-tree +EXTRA_STAGE2_CONFIGURE_FLAGS += --flags=in-ghc-tree include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/cabal.mk diff --git a/haddock.cabal b/haddock.cabal index 5f486bd3..8756592a 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -57,9 +57,9 @@ data-files: html/minus.gif html/plus.gif -flag ghc-paths - description: Should we use ghc-paths to find GHC? This is always enabled, except when building in a GHC tree. - default: True +flag in-ghc-tree + description: Are we in a GHC tree? + default: False manual: True executable haddock @@ -73,9 +73,11 @@ executable haddock containers, array - if flag(ghc-paths) + if flag(in-ghc-tree) + cpp-options: -DIN_GHC_TREE + extensions: ForeignFunctionInterface + else build-depends: ghc-paths - cpp-options: -DGHC_PATHS if impl(ghc >= 6.9) build-depends: Cabal >= 1.5, getopt diff --git a/src/Main.hs b/src/Main.hs index 310214c6..3e9d6422 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -33,9 +33,16 @@ import Data.Dynamic import Data.Maybe import Data.IORef import qualified Data.Map as Map +import Data.Version import System.IO import System.Exit import System.Environment +import System.FilePath +#ifdef IN_GHC_TREE +import Foreign +import Foreign.C +import Data.Int +#endif import GHC #ifdef GHC_PATHS @@ -140,10 +147,10 @@ main = handleTopExceptions $ do let libDir | Just dir <- getGhcLibDir flags = dir | otherwise = -#ifdef GHC_PATHS - libdir -- from GHC.Paths +#ifdef IN_GHC_TREE + error "No GhcLibDir found" #else - error "No GhcLibDir" + libdir -- from GHC.Paths #endif -- initialize GHC @@ -200,7 +207,17 @@ render flags interfaces installedIfaces = do verbose = Flag_Verbose `elem` flags libdir <- case [str | Flag_Lib str <- flags] of - [] -> getDataDir -- provided by Cabal + [] -> +#ifdef IN_GHC_TREE + do m <- getExecDir + case m of + Nothing -> error "No libdir found" + Just d -> + return (d </> ".." </> "share" + </> ("haddock-" ++ showVersion version)) +#else + getDataDir -- provided by Cabal +#endif fs -> return (last fs) let css_file = case [str | Flag_CSS str <- flags] of @@ -350,3 +367,21 @@ getPrologue flags Left err -> throwE err Right doc -> return (Just doc) _otherwise -> throwE "multiple -p/--prologue options" + +getExecDir :: IO (Maybe String) +#if defined(mingw32_HOST_OS) +getExecDir = allocaArray len $ \buf -> do + ret <- getModuleFileName nullPtr buf len + if ret == 0 + then return Nothing + else do s <- peekCString buf + return (Just (dropFileName s)) + where len = 2048 -- Plenty, PATH_MAX is 512 under Win32. + +foreign import stdcall unsafe "GetModuleFileNameA" + getModuleFileName :: Ptr () -> CString -> Int -> IO Int32 +#else +getExecDir = return Nothing +#endif + + |