cvs pulls from krasimir and ross

* Ross
  ghcconfig.h is not needed for GHC >= 6.4
  update library links for haddock 0.7 (in Cabal.xml)

* Krasimir
  * The sentence:
  
    An error will be returned from <literal>setup configure</literal> if
    this is not the case.
  
  is replaced with:
  
    If this is not the case then the compiled executable will have baked
    in all absolute paths.

  * The previous implementation for Paths_<pkgid>.hs building was broken on Windows.
  The prefixRel function was expecting that all bindir/libdir/datadir/... paths
  are $prefix relative but the corresponding functions (mkBinDir/mkLibDir/...)
  was returning absolute paths with expanded $path variable. This commit fixes
  the bug and also:
  
     * In LocalBuildInfo are added mkLibDirRel/mkBinDirRel/... functions. They
  return the corresponding but without the $prefix part. When the path isn't
  prefix relative then they return Nothing
     * The restriction that all paths on Windows are $prefix relative is removed.
     * The code in Paths_<pkgid>.hs can contain both absolute and prefix relative
  paths. When the package is configured only with $prefix relative paths then
  the generated executable will be prefix independent and can be moved from one
  directory to another.

  * Paths_<pkg>.hs was generated before each build and this was causing GHC to
  rebuild the package each time. Now it is generated only when it is older than
  .setup-config

  * Change the foreign import syntax to use the standard FFI syntax

  * Two changes to HADDOCK support:
  
      - In the last version only the exposed modules were passed to haddock.
  In order to generate proper documentation all modules should be processed
  from haddock but the non exposed modules should be hiden.
      - Added support for executable packages in Haddock.

Distribution/Compat/Directory.hs

@@ -3,7 +3,7 @@ module Distribution.Compat.Directory (
         removeDirectoryRecursive, module System.Directory
   ) where
 
-#if __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #else

Distribution/Compat/FilePath.hs

@@ -33,7 +33,7 @@ module Distribution.Compat.FilePath
          , dllExtension
          ) where
 
-#if __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #else

Distribution/Simple.hs

@@ -88,7 +88,7 @@ import Distribution.Simple.Configure(LocalBuildInfo(..), getPersistBuildConfig,
 import Distribution.Simple.Install(install)
 import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose,
                                   defaultPackageDesc, defaultHookedPackageDesc,
-                                  moduleToFilePath)
+                                  moduleToFilePath, findFile)
 #if mingw32_HOST_OS || mingw32_TARGET_OS
 import Distribution.Simple.Utils (rawSystemPath)
 #endif
@@ -403,40 +403,62 @@ distPref :: FilePath
 distPref = "dist"
 
 haddock :: PackageDescription -> LocalBuildInfo -> Int -> [PPSuffixHandler] -> IO ()
-haddock pkg_descr lbi verbose pps =
-    withLib pkg_descr () $ \lib -> do
-        confHaddock <- do let programConf = withPrograms lbi
-                          let haddockName = programName $ haddockProgram
-                          mHaddock <- lookupProgram haddockName programConf
-                          case mHaddock of
-                            Nothing -> (die "haddock command not found")
-                            Just h  -> return h
+haddock pkg_descr lbi verbose pps = do
+    confHaddock <- do let programConf = withPrograms lbi
+                      let haddockName = programName $ haddockProgram
+                      mHaddock <- lookupProgram haddockName programConf
+                      case mHaddock of
+                        Nothing -> (die "haddock command not found")
+                        Just h  -> return h
 
+    let targetDir = joinPaths distPref (joinPaths "doc" "html")
+    let tmpDir = joinPaths (buildDir lbi) "tmp"
+    createDirectoryIfMissing True tmpDir
+    createDirectoryIfMissing True targetDir
+    preprocessSources pkg_descr lbi verbose pps
+
+    setupMessage "Running Haddock for" pkg_descr
+
+    withLib pkg_descr () $ \lib -> do
         let bi = libBuildInfo lib
-        let targetDir = joinPaths distPref (joinPaths "doc" "html")
-        let tmpDir = joinPaths (buildDir lbi) "tmp"
-        createDirectoryIfMissing True tmpDir
-        createDirectoryIfMissing True targetDir
-        preprocessSources pkg_descr lbi verbose pps
         inFiles <- sequence [moduleToFilePath (hsSourceDirs bi) m ["hs", "lhs"]
-                               | m <- exposedModules lib] >>= return . concat
+                               | m <- exposedModules lib ++ otherModules bi] >>= return . concat
         mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles
         let showPkg = showPackageId (package pkg_descr)
         let prologName = showPkg ++ "-haddock-prolog.txt"
         writeFile prologName ((description pkg_descr) ++ "\n")
-        setupMessage "Running Haddock for" pkg_descr
         let outFiles = map (joinFileName tmpDir)
                        (map ((flip changeFileExt) "hs") inFiles)
-        code <- rawSystemProgram verbose confHaddock
+        rawSystemProgram verbose confHaddock
                 (["-h",
                   "-o", targetDir,
                   "-t", showPkg,
                   "-p", prologName] ++ (programArgs confHaddock)
                 ++ (if verbose > 4 then ["-v"] else [])
                 ++ outFiles
+                ++ map ((++) "--hide=") (otherModules bi)
                 )
-        removeDirectoryRecursive tmpDir
         removeFile prologName
+    withExe pkg_descr $ \exe -> do
+        let bi = buildInfo exe
+            exeTargetDir = targetDir `joinFileName` exeName exe
+        createDirectoryIfMissing True exeTargetDir
+        inFiles' <- sequence [moduleToFilePath (hsSourceDirs bi) m ["hs", "lhs"]
+                               | m <- otherModules bi] >>= return . concat
+        srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe)
+        let inFiles = srcMainPath : inFiles'
+        mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles
+        let outFiles = map (joinFileName tmpDir)
+                       (map ((flip changeFileExt) "hs") inFiles)
+        rawSystemProgram verbose confHaddock
+                (["-h",
+                  "-o", exeTargetDir,
+                  "-t", exeName exe] ++ (programArgs confHaddock)
+                ++ (if verbose > 4 then ["-v"] else [])
+                ++ outFiles
+                )
+
+    removeDirectoryRecursive tmpDir
   where
         mockPP inputArgs pkg_descr bi lbi pref verbose file
             = do let (filePref, fileName) = splitFileName file

Distribution/Simple/Build.hs

@@ -58,8 +58,11 @@ import Distribution.PreProcess (preprocessSources, PPSuffixHandler, ppCpp)
 import Distribution.PreProcess.Unlit (unlit)
 import Distribution.Version (Version(..))
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), 
-					   mkBinDir, mkLibDir, mkDataDir,
-					   mkLibexecDir)
+					   mkBinDir, mkBinDirRel,
+					   mkLibDir, mkLibDirRel,
+					   mkDataDir,mkDataDirRel,
+					   mkLibexecDir, mkLibexecDirRel)
+import Distribution.Simple.Configure (localBuildInfoFile)
 import Distribution.Simple.Install (hugsMainFilename)
 import Distribution.Simple.Utils (rawSystemExit, die, rawSystemPathExit,
                                   mkLibName, mkProfLibName, mkGHCiLibName, dotToSep,
@@ -70,15 +73,15 @@ import Distribution.Simple.Utils (rawSystemExit, die, rawSystemPathExit,
 import Language.Haskell.Extension (Extension(..))
 
 import Data.Char(isSpace)
-import Data.Maybe(mapMaybe, maybeToList)
+import Data.Maybe(mapMaybe, maybeToList, fromJust)
 import Control.Monad (unless, when, filterM)
 #ifndef __NHC__
 import Control.Exception (try)
 #else
 import IO (try)
 #endif
 import Data.List(nub, sort, isSuffixOf)
-import System.Directory (removeFile)
+import System.Directory (removeFile, getModificationTime, doesFileExist)
 import Distribution.Compat.Directory (copyFile,createDirectoryIfMissing)
 import Distribution.Compat.FilePath (splitFilePath, joinFileName,
                                 splitFileExt, joinFileExt, objExtension,
@@ -513,7 +516,7 @@ buildPathsModule pkg_descr lbi =
 	| absolute = ""
 	| otherwise =
 	  "{-# OPTIONS_GHC -fffi #-}\n"++
-	  "{-# LANGUAGE FFI #-}\n"
+	  "{-# LANGUAGE ForeignFunctionInterface #-}\n"
 
        foreign_imports
 	| absolute = ""
@@ -553,79 +556,83 @@ buildPathsModule pkg_descr lbi =
 	  "getDataFileName name = return (datadir ++ "++path_sep++" ++ name)\n"
 	| otherwise =
 	  "\nprefix        = " ++ show (prefix lbi) ++
-	  "\nbindirrel     = " ++ show (prefixRel flat_bindir) ++
-	  "\nlibdirrel     = " ++ show (prefixRel flat_libdir) ++
-	  "\ndatadirrel    = " ++ show (prefixRel flat_datadir) ++
-	  "\nlibexecdirrel = " ++ show (prefixRel flat_libexecdir) ++
+	  "\nbindirrel     = " ++ show (fromJust flat_bindirrel) ++
 	  "\n"++
 	  "\ngetBinDir :: IO FilePath\n"++
-	  "getBinDir = do\n"++
-	  "  m <- getPrefix bindirrel\n"++
-	  "  return (fromMaybe prefix m `joinFileName` bindirrel)\n"++
+	  "getBinDir = getPrefixDirRel bindirrel\n\n"++
 	  "getLibDir :: IO FilePath\n"++
-	  "getLibDir = do\n"++
-	  "  m <- getPrefix bindirrel\n"++
-	  "  return (fromMaybe prefix m `joinFileName` libdirrel)\n"++
+	  "getLibDir = "++mkGetDir flat_libdir flat_libdirrel++"\n\n"++
 	  "getDataDir :: IO FilePath\n"++
-	  "getDataDir = do\n"++
-	  "  m <- getPrefix bindirrel\n"++
-	  "  return (fromMaybe prefix m `joinFileName` datadirrel)\n"++
-	  "\n"++
+	  "getDataDir =  "++mkGetDir flat_datadir flat_datadirrel++"\n\n"++
+	  "getLibexecDir :: IO FilePath\n"++
+	  "getLibexecDir = "++mkGetDir flat_libexecdir flat_libexecdirrel++"\n\n"++
 	  "getDataFileName :: FilePath -> IO FilePath\n"++
 	  "getDataFileName name = do\n"++
 	  "  dir <- getDataDir\n"++
 	  "  return (dir `joinFileName` name)\n"++
 	  "\n"++
 	  get_prefix_stuff
-   in
-   writeFile (autogenModulesDir lbi `joinFileName` paths_filename) (header++body)
+   in do btime <- getModificationTime localBuildInfoFile
+   	 exists <- doesFileExist paths_filepath
+   	 ptime <- if exists
+   	            then getModificationTime paths_filepath
+   	            else return btime
+	 if btime >= ptime
+	   then writeFile paths_filepath (header++body)
+	   else return ()
  where
-	flat_bindir     = mkBinDir pkg_descr lbi NoCopyDest
-	flat_libdir     = mkLibDir pkg_descr lbi NoCopyDest
-	flat_datadir    = mkDataDir pkg_descr lbi NoCopyDest
-	flat_libexecdir = mkLibexecDir pkg_descr lbi NoCopyDest
+	flat_bindir        = mkBinDir pkg_descr lbi NoCopyDest
+	flat_bindirrel     = mkBinDirRel pkg_descr lbi NoCopyDest
+	flat_libdir        = mkLibDir pkg_descr lbi NoCopyDest
+	flat_libdirrel     = mkLibDirRel pkg_descr lbi NoCopyDest
+	flat_datadir       = mkDataDir pkg_descr lbi NoCopyDest
+	flat_datadirrel    = mkDataDirRel pkg_descr lbi NoCopyDest
+	flat_libexecdir    = mkLibexecDir pkg_descr lbi NoCopyDest
+	flat_libexecdirrel = mkLibexecDirRel pkg_descr lbi NoCopyDest
+
+	mkGetDir dir (Just dirrel) = "getPrefixDirRel " ++ show dirrel
+	mkGetDir dir Nothing       = "return " ++ show dir
 
 #if mingw32_HOST_OS
-	absolute = hasLibs pkg_descr
+	absolute = hasLibs pkg_descr || flat_bindirrel == Nothing
 #else
 	absolute = True
 #endif
 
   	paths_modulename = "Paths_" ++ fix (pkgName (package pkg_descr))
 	paths_filename = paths_modulename ++ ".hs"
+	paths_filepath = autogenModulesDir lbi `joinFileName` paths_filename
 
 	path_sep = show [pathSeparator]
 
 	fix = map fixchar 
 	  where fixchar '-' = '_'
 		fixchar c   = c
 
-	prefixRel ('$':'p':'r':'e':'f':'i':'x':s) = s
-	prefixRel _ = error "buildPathsModule"
-
 get_prefix_stuff =
-  "getPrefix :: FilePath -> IO (Maybe FilePath)\n"++
-  "getPrefix binDirRel = do \n"++
+  "getPrefixDirRel :: FilePath -> IO FilePath\n"++
+  "getPrefixDirRel dirRel = do \n"++
   "  let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
   "  buf <- mallocArray len\n"++
   "  ret <- getModuleFileName nullPtr buf len\n"++
   "  if ret == 0 \n"++
-  "     then do free buf; return Nothing\n"++
-  "     else do s <- peekCString buf\n"++
-  "          free buf\n"++
-  "          return (Just (prefixFromExePath s binDirRel))\n"++
+  "     then do free buf;\n"++
+  "             return (prefix `joinFileName` dirRel)\n"++
+  "     else do exePath <- peekCString buf\n"++
+  "             free buf\n"++
+  "             let (bindir,_) = splitFileName exePath\n"++
+  "             return (prefixFromBinDir bindir bindirrel `joinFileName` dirRel)\n"++
+  "  where\n"++
+  "    prefixFromBinDir bindir path\n"++
+  "      | path' == \".\" = bindir'\n"++
+  "      | otherwise    = prefixFromBinDir bindir' path'\n"++
+  "      where\n"++
+  "        (bindir',_) = splitFileName bindir\n"++
+  "        (path',  _) = splitFileName path\n"++
   "\n"++
-  "foreign import stdcall \"GetModuleFileNameA\" unsafe\n"++
+  "foreign import stdcall unsafe \"GetModuleFileNameA\"\n"++
   "  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"++
   "\n"++
-  "prefixFromExePath :: FilePath -> FilePath -> FilePath\n"++
-  "prefixFromExePath exe_path binDirRel\n"++
-  "  = bindir `joinFileName` foldr joinFileName \".\" dotdots\n"++
-  "  where\n"++
-  "   (bindir,exe) = splitFileName exe_path\n"++
-  "   bincomps = breakFilePath binDirRel -- something like [\".\",\"bin\"]\n"++
-  "   dotdots = take (length bincomps) (repeat \"..\")\n"++
-  "\n"++
   "joinFileName :: String -> String -> FilePath\n"++
   "joinFileName \"\"  fname = fname\n"++
   "joinFileName \".\" fname = fname\n"++
@@ -647,19 +654,12 @@ get_prefix_stuff =
   "      (c:path) | isPathSeparator c -> path\n"++
   "      _                            -> path1\n"++
   "\n"++
-  "breakFilePath :: FilePath -> [String]\n"++
-  "breakFilePath = worker []\n"++
-  "    where worker ac path\n"++
-  "              | less == path = less:ac\n"++
-  "              | otherwise = worker (current:ac) less\n"++
-  "              where (less,current) = splitFileName path\n"++
-  "\n"++
   "pathSeparator :: Char\n"++
-  "pathSeparator = '\\'\n"++
+  "pathSeparator = '\\\\'\n"++
   "\n"++
   "isPathSeparator :: Char -> Bool\n"++
   "isPathSeparator ch =\n"++
-  "  ch == '/' || ch == '\\'\n"
+  "  ch == '/' || ch == '\\\\'\n"
 
 -- ------------------------------------------------------------
 -- * Testing

Distribution/Simple/Configure.hs

@@ -54,7 +54,7 @@ module Distribution.Simple.Configure (writePersistBuildConfig,
                                      )
     where
 
-#if __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #else
@@ -146,21 +146,6 @@ configure pkg_descr cfg
 		my_datasubdir = fromMaybe default_datasubdir
 				  (configDataSubDir cfg)
 
-	-- on Windows, our directories should all be relative to $prefix if we're
-	-- building an executable, so we can be prefix-independent
-#if mingw32_HOST_OS	
-	let checkPrefix (s,('$':'p':'r':'e':'f':'i':'x':_)) = return ()
-	    checkPrefix (s,_other) = 
-		die (s ++ " must begin with $prefix for an executable")
-	mapM_ checkPrefix [
-		("bindir",my_bindir),
-		("libdir",my_libdir),
-		("libexecdir",my_libexecdir)
-	    ]
-	unless (hasLibs pkg_descr) $
-	  checkPrefix ("datadir",my_datadir)
-#endif
-
         -- check extensions
         let extlist = nub $ maybe [] (extensions . libBuildInfo) lib ++
                       concat [ extensions exeBi | Executable _ _ exeBi <- executables pkg_descr ]

Distribution/Simple/Install.hs

@@ -50,7 +50,7 @@ module Distribution.Simple.Install (
 #endif
   ) where
 
-#if __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #else