Fix Compat.H98 breakage, improve copyFile

I moved a lot of the ifdef:ing into the Compat.* modules, makes
a lot more sense.

Compat/Exception.hs

+{-# OPTIONS -cpp #-}
+module Compat.Exception (bracket) where
+
+#ifdef __NHC__
+import System.IO.Error (catch, ioError)
+#else
+import Control.Exception (bracket)
+#endif
+
+#ifdef __NHC__
+bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
+bracket before after thing
+  = do a <- before
+       r <- thing a `catch` \e -> do after a
+                                     ioError e
+       after a
+       return r
+#endif

Compat/H98.hs

-{-# OPTIONS_COMPILE -prelude #-}
-module Compat.H98 where
+{-# OPTIONS -cpp #-}
+module Compat.H98 (Error(..)) where
 
+#ifndef __NHC__
+import Control.Monad.Error (Error(..))
+#endif
+
+#ifdef __NHC__
 class Error e where
         strMsg :: String -> e
 
@@ -16,3 +21,4 @@ instance Error e => Monad (Either e) where
         fail   = Left . strMsg
         Left e  >>= f = Left e
         Right x >>= f = f x
+#endif

Compat/RawSystem.hs

+{-# OPTIONS -cpp #-}
 module Compat.RawSystem (rawSystem) where
 
+#ifndef __GLASGOW_HASKELL__
 import Data.List (intersperse)
 import System.Cmd (system)
 import System.Exit (ExitCode)
+#else
+import System.Cmd (rawSystem)
+#endif
 
+
+#ifndef __GLASGOW_HASKELL__
 rawSystem :: String -> [String] -> IO ExitCode
 rawSystem p args = system $ concat $ intersperse " " (p : map esc args)
   where esc arg = "\"" ++ arg ++ "\"" -- this is hideously broken, actually
+#endif

Distribution/Package.hs

@@ -56,12 +56,6 @@ module Distribution.Package (
   ) where
 
 import Control.Monad(foldM)
-#ifdef __NHC__
--- nhc doesn't have C.M.Error (which defines Monad (Either String))
-import Compat.H98
-#else
-import Control.Monad.Error
-#endif
 import Data.Char
 import Data.List(isPrefixOf)
 import Data.Maybe(fromMaybe)
@@ -73,6 +67,7 @@ import Distribution.Setup(CompilerFlavor(..))
 
 import System.IO(openFile, IOMode(..), hGetContents)
 
+import Compat.H98
 import Compat.ReadP
 
 #ifdef DEBUG

Distribution/Setup.hs

@@ -67,11 +67,7 @@ import System.Console.GetOpt
 import System.Exit
 import System.Environment
 
-#ifdef __NHC__
-import Compat.H98
-#else
-import Control.Monad.Error
-#endif
+import Compat.H98 ()
 
 -- ------------------------------------------------------------
 -- * Command Line Types and Exports

Distribution/Simple/Utils.hs

@@ -71,16 +71,21 @@ import Distribution.Package (PackageDescription(..), showPackageId)
 import Control.Monad(when, unless, liftM, mapM)
 import Data.List(inits, nub, intersperse, findIndices, partition)
 import Data.Maybe(Maybe, listToMaybe, isNothing, fromJust, catMaybes)
-import System.IO (hPutStr, stderr)
+import System.IO (hPutStr, stderr
+#ifndef __NHC__
+                 , openBinaryFile, IOMode(..), hGetBuf, hPutBuf, hClose
+#endif
+                 )
 import System.IO.Error
 import System.Exit
-#ifdef __GLASGOW_HASKELL__
-import System.Cmd (rawSystem)
-#else
 import Compat.RawSystem (rawSystem)
-#endif
+import Compat.Exception (bracket)
 import System.Environment
 import System.Directory
+import Foreign.Marshal (allocaBytes)
+#ifdef HAVE_UNIX_PACKAGE
+import System.Posix.Files (getFileStatus, accessTime, modificationTime, setFileTimes)
+#endif
 
 #ifdef DEBUG
 import HUnit ((~:), (~=?), Test(..), assertEqual)
@@ -318,13 +323,32 @@ mkLibName pref lib = pathJoin [pref, ("libHS" ++ lib ++ ".a")]
 pathJoin :: [String] -> FilePath
 pathJoin = concat . intersperse pathSeparatorStr
 
--- |Preserves permissions, FIX: does not preserve dates
+-- |Preserves permissions and, if possible, atime+mtime
 copyFile :: FilePath -> FilePath -> IO ()
 copyFile src dest 
     | dest == src = fail "copyFile: source and destination are the same file"
+#ifdef __NHC__
     | otherwise = do readFile src >>= writeFile dest
-                     p <- getPermissions src
-                     setPermissions dest p
+                     try (getPermissions src >>= setPermissions dest)
+                     return ()
+#else
+    | otherwise = bracket (openBinaryFile src ReadMode) hClose $ \hSrc ->
+                  bracket (openBinaryFile src WriteMode) hClose $ \hDest ->
+                  do allocaBytes bufSize $ \buffer -> copyContents hSrc hDest buffer
+                     try (getPermissions src >>= setPermissions dest)
+#ifdef HAVE_UNIX_PACKAGE
+                     try $ do st <- getFileStatus src
+                              let atime = accessTime st
+                                  mtime = modificationTime st
+                              setFileTimes dest atime mtime
+#endif
+                     return ()
+  where bufSize = 1024
+        copyContents hSrc hDest buffer
+           = do count <- hGetBuf hSrc buffer bufSize
+                when (count > 0) $ do hPutBuf hDest buffer count
+                                      copyContents hSrc hDest buffer
+#endif
 
 partitionIO :: (a -> IO Bool) -> [a] -> IO ([a], [a])
 partitionIO f l

Makefile

@@ -17,8 +17,11 @@ setup:
 	mkdir -p dist/tmp
 	ghc $(GHCFLAGS) -odir dist/tmp -hidir dist/tmp Setup -o setup
 
+Setup-nhc:
+	hmake -nhc98 -package base -prelude Setup
+
 config: setup
-	./setup configure --prefix=$(PREF)
+	./setup configure --ghc --prefix=$(PREF)
 
 build: build-stamp
 build-stamp: config

Setup.description

@@ -12,4 +12,4 @@ Modules: Distribution.Package, Distribution.Version,
          Distribution.Simple.Register, 
          Distribution.Simple.GHCPackageConfig, 
          Distribution.GetOpt,
-         Compat.ReadP
\ No newline at end of file
+         Compat.ReadP, Compat.H98