Re-direct compilation output to a temporary directory

Also add a flag --no-tmp-comp-dir that can be used to get the old behaviour of
writing compilation files to GHC's output directory (default ".").

1 files changed, 19 insertions, 31 deletions

diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 3c0b302c..b9795376 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -43,7 +43,10 @@ module Haddock.Utils (
   
   -- * Logging
   parseVerbosity,
-  out
+  out,
+
+  -- * System tools
+  getProcessID
  ) where
 
 
@@ -69,6 +72,13 @@ import System.FilePath
 import Distribution.Verbosity
 import Distribution.ReadE
 
+#ifndef mingw32_HOST_OS
+import qualified System.Posix.Internals
+#else /* Must be Win32 */
+import Foreign
+import Foreign.C.String
+#endif
+
 import MonadUtils ( MonadIO(..) )
 
 
@@ -368,36 +378,14 @@ idMarkup = Markup {
   }
 
 
------------------------------------------------------------------------------
--- put here temporarily
-
-
-newtype FormatVersion = FormatVersion Int deriving (Eq,Ord)
-
-
-nullFormatVersion :: FormatVersion
-nullFormatVersion = mkFormatVersion 0
-
+-- -----------------------------------------------------------------------------
+-- System tools
 
-mkFormatVersion :: Int -> FormatVersion
-mkFormatVersion = FormatVersion
 
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
+#else
+getProcessID :: IO Int
+getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
+#endif
 
-instance Binary FormatVersion where
-   put_ bh (FormatVersion i) =
-      case compare i 0 of
-         EQ -> return ()
-         GT -> put_ bh (-i)
-         LT -> error (
-            "Binary.hs: negative FormatVersion " ++ show i 
-               ++ " is not allowed")
-   get bh =
-      do
-         (w8 :: Word8) <- get bh   
-         if testBit w8 7
-            then
-               do
-                  i <- get bh
-                  return (FormatVersion (-i))
-            else
-               return nullFormatVersion