Drop code to handle unsupported compilers

This means tweaking CPP conditionals and file pragmas to remove handling
of compilers other than GHC, and GHC versions before LANGUAGE pragmas
existed.

Cabal/Distribution/Compat/CopyFile.hs

-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -cpp #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp #-}
 {-# OPTIONS_HADDOCK hide #-}
 module Distribution.Compat.CopyFile (
   copyFile,
@@ -14,7 +9,6 @@ module Distribution.Compat.CopyFile (
   setDirOrdinary,
   ) where
 
-#ifdef __GLASGOW_HASKELL__
 
 import Control.Monad
          ( when )
@@ -36,7 +30,6 @@ import System.IO
          ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf )
 import Foreign
          ( allocaBytes )
-#endif /* __GLASGOW_HASKELL__ */
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Internals (withFilePath)
@@ -69,7 +62,6 @@ setFileExecutable _ = return ()
 setDirOrdinary = setFileExecutable
 
 copyFile :: FilePath -> FilePath -> IO ()
-#ifdef __GLASGOW_HASKELL__
 copyFile fromFPath toFPath =
   copy
     `catchIO` (\ioe -> throwIOIO (ioeSetLocation ioe "copyFile"))
@@ -89,6 +81,3 @@ copyFile fromFPath toFPath =
                   when (count > 0) $ do
                           hPutBuf hTo buffer count
                           copyContents hFrom hTo buffer
-#else
-copyFile fromFPath toFPath = readFile fromFPath >>= writeFile toFPath
-#endif

Cabal/Distribution/Compat/Exception.hs

-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -cpp #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp #-}
-
-#if !defined(__HUGS__)
-#define NEW_EXCEPTION
-#endif
-
 module Distribution.Compat.Exception (
      Exception.IOException,
      onException,
@@ -22,40 +11,17 @@ import System.Exit
 import qualified Control.Exception as Exception
 
 onException :: IO a -> IO b -> IO a
-#ifdef NEW_EXCEPTION
 onException = Exception.onException
-#else
-onException io what = io `Exception.catch` \e -> do what
-                                                    Exception.throw e
-#endif
 
 throwIOIO :: Exception.IOException -> IO a
-#ifdef NEW_EXCEPTION
 throwIOIO = Exception.throwIO
-#else
-throwIOIO = Exception.throwIO . Exception.IOException
-#endif
 
 tryIO :: IO a -> IO (Either Exception.IOException a)
-#ifdef NEW_EXCEPTION
 tryIO = Exception.try
-#else
-tryIO = Exception.tryJust Exception.ioErrors
-#endif
 
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
-#ifdef NEW_EXCEPTION
 catchIO = Exception.catch
-#else
-catchIO = Exception.catchJust Exception.ioErrors
-#endif
 
 catchExit :: IO a -> (ExitCode -> IO a) -> IO a
-#ifdef NEW_EXCEPTION
 catchExit = Exception.catch
-#else
-catchExit = Exception.catchJust exitExceptions
-    where exitExceptions (Exception.ExitException ee) = Just ee
-          exitExceptions _                            = Nothing
-#endif
 

Cabal/Distribution/Compat/TempFile.hs

-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -cpp #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp #-}
 {-# OPTIONS_HADDOCK hide #-}
 module Distribution.Compat.TempFile (
   openTempFile,
@@ -16,13 +11,6 @@ module Distribution.Compat.TempFile (
 import System.FilePath        ((</>))
 import Foreign.C              (eEXIST)
 
-#if __NHC__ || __HUGS__
-import System.IO              (openFile, openBinaryFile,
-                               Handle, IOMode(ReadWriteMode))
-import System.Directory       (doesFileExist)
-import System.FilePath        ((<.>), splitExtension)
-import System.IO.Error        (try, isAlreadyExistsError)
-#else
 import System.IO              (Handle, openTempFile, openBinaryTempFile)
 import Data.Bits              ((.|.))
 import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,
@@ -32,15 +20,9 @@ import System.Posix.Internals (withFilePath)
 import Foreign.C              (CInt)
 import GHC.IO.Handle.FD       (fdToHandle)
 import Distribution.Compat.Exception (onException, tryIO)
-#endif
 import Foreign.C              (getErrno, errnoToIOError)
 
-#if __NHC__
-import System.Posix.Types     (CPid(..))
-foreign import ccall unsafe "getpid" c_getpid :: IO CPid
-#else
 import System.Posix.Internals (c_getpid)
-#endif
 
 #ifdef mingw32_HOST_OS
 import System.Directory       ( createDirectory )
@@ -56,43 +38,6 @@ import qualified System.Posix
 -- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.
 -- TODO: Not sure about jhc
 
-#if __NHC__ || __HUGS__
--- use a temporary filename that doesn't already exist.
--- NB. *not* secure (we don't atomically lock the tmp file we get)
-openTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openTempFile tmp_dir template
-  = do x <- getProcessID
-       findTempName x
-  where
-    (templateBase, templateExt) = splitExtension template
-    findTempName :: Int -> IO (FilePath, Handle)
-    findTempName x
-      = do let path = tmp_dir </> (templateBase ++ "-" ++ show x) <.> templateExt
-           b  <- doesFileExist path
-           if b then findTempName (x+1)
-                else do hnd <- openFile path ReadWriteMode
-                        return (path, hnd)
-
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template
-  = do x <- getProcessID
-       findTempName x
-  where
-    (templateBase, templateExt) = splitExtension template
-    findTempName :: Int -> IO (FilePath, Handle)
-    findTempName x
-      = do let path = tmp_dir </> (templateBase ++ "-" ++ show x) <.> templateExt
-           b  <- doesFileExist path
-           if b then findTempName (x+1)
-                else do hnd <- openBinaryFile path ReadWriteMode
-                        return (path, hnd)
-
-openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)
-openNewBinaryFile = openBinaryTempFile
-
-getProcessID :: IO Int
-getProcessID = fmap fromIntegral c_getpid
-#else
 -- This is a copy/paste of the openBinaryTempFile definition, but
 -- if uses 666 rather than 600 for the permissions. The base library
 -- needs to be changed to make this better.
@@ -159,7 +104,6 @@ std_flags, output_flags, rw_flags :: CInt
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
 rw_flags     = output_flags .|. o_RDWR
-#endif
 
 createTempDirectory :: FilePath -> String -> IO FilePath
 createTempDirectory dir template = do

Cabal/Distribution/PackageDescription/Configuration.hs

-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
-{-# LANGUAGE CPP #-}
 -- -fno-warn-deprecations for use of Map.foldWithKey
-{-# OPTIONS_GHC -cpp -fno-warn-deprecations #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp #-}
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Configuration

Cabal/Distribution/Simple/InstallDirs.hs

 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp -fffi #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Simple.InstallDirs
@@ -559,9 +557,6 @@ getWindowsProgramFilesDir = do
 #if mingw32_HOST_OS
 shGetFolderPath :: CInt -> IO (Maybe FilePath)
 shGetFolderPath n =
-# if __HUGS__
-  return Nothing
-# else
   allocaArray long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath
      if (r /= 0)
@@ -569,7 +564,6 @@ shGetFolderPath n =
         else do s <- peekCWString pPath; return (Just s)
   where
     long_path_size      = 1024 -- MAX_PATH is 260, this should be plenty
-# endif
 
 csidl_PROGRAM_FILES :: CInt
 csidl_PROGRAM_FILES = 0x0026

Cabal/Distribution/Simple/Utils.hs

 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp -fffi #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Simple.Utils
@@ -141,10 +139,8 @@ module Distribution.Simple.Utils (
 
 import Control.Monad
     ( when, unless, filterM )
-#ifdef __GLASGOW_HASKELL__
 import Control.Concurrent.MVar
     ( newEmptyMVar, putMVar, takeMVar )
-#endif
 import Data.List
   ( nub, unfoldr, isPrefixOf, tails, intercalate )
 import Data.Char as Char
@@ -176,10 +172,8 @@ import System.IO
 import System.IO.Error as IO.Error
     ( isDoesNotExistError, isAlreadyExistsError
     , ioeSetFileName, ioeGetFileName, ioeGetErrorString )
-#if !defined(__HUGS__)
 import System.IO.Error
     ( ioeSetLocation, ioeGetLocation )
-#endif
 import System.IO.Unsafe
     ( unsafeInterleaveIO )
 import qualified Control.Exception as Exception
@@ -196,16 +190,11 @@ import Distribution.Version
 import Control.Exception (evaluate)
 import System.Process (runProcess)
 
-#ifdef __GLASGOW_HASKELL__
 import Control.Concurrent (forkIO)
 import System.Process (runInteractiveProcess, waitForProcess)
 #if __GLASGOW_HASKELL__ >= 702
 import System.Process (showCommandForUser)
 #endif
-#else
-import System.Cmd (system)
-import System.Directory (getTemporaryDirectory)
-#endif
 
 import Distribution.Compat.CopyFile
          ( copyFile, copyOrdinaryFile, copyExecutableFile
@@ -239,12 +228,8 @@ dieWithLocation filename lineno msg =
           . flip ioeSetFileName (normalise filename)
           $ userError msg
   where
-#if defined(__HUGS__)
-    setLocation _        err = err
-#else
     setLocation Nothing  err = err
     setLocation (Just n) err = ioeSetLocation err (show n)
-#endif
 
 die :: String -> IO a
 die msg = ioError (userError msg)
@@ -262,13 +247,9 @@ topHandler prog = catchIO prog handle
         file         = case ioeGetFileName ioe of
                          Nothing   -> ""
                          Just path -> path ++ location ++ ": "
-#if defined(__HUGS__)
-        location     = ""
-#else
         location     = case ioeGetLocation ioe of
                          l@(n:_) | n >= '0' && n <= '9' -> ':' : l
                          _                              -> ""
-#endif
         detail       = ioeGetErrorString ioe
 
 -- | Non fatal conditions that may be indicative of an error or problem.
@@ -465,7 +446,6 @@ rawSystemStdInOut :: Verbosity
 rawSystemStdInOut verbosity path args input outputBinary = do
   printRawCommandAndArgs verbosity path args
 
-#ifdef __GLASGOW_HASKELL__
   Exception.bracket
      (runInteractiveProcess path args Nothing Nothing)
      (\(inh,outh,errh,_) -> hClose inh >> hClose outh >> hClose errh)
@@ -512,33 +492,6 @@ rawSystemStdInOut verbosity path args input outputBinary = do
                           " with error message:\n" ++ err
 
       return (out, err, exitcode)
-#else
-  tmpDir <- getTemporaryDirectory
-  withTempFile tmpDir ".cmd.stdout" $ \outName outHandle ->
-   withTempFile tmpDir ".cmd.stdin" $ \inName inHandle -> do
-    hClose outHandle
-
-    case input of
-      Nothing -> return ()
-      Just (inputStr, inputBinary) -> do
-        hSetBinaryMode inHandle inputBinary
-        hPutStr inHandle inputStr
-    hClose inHandle
-
-    let quote name = "'" ++ name ++ "'"
-        cmd = unwords (map quote (path:args))
-           ++ " <" ++ quote inName
-           ++ " >" ++ quote outName
-    exitcode <- system cmd
-
-    unless (exitcode == ExitSuccess) $
-      debug verbosity $ path ++ " returned " ++ show exitcode
-
-    Exception.bracket (openFile outName ReadMode) hClose $ \hnd -> do
-      hSetBinaryMode hnd outputBinary
-      output <- hGetContents hnd
-      length output `seq` return (output, "", exitcode)
-#endif
 
 
 -- | Look for a program on the path.

cabal-install/Distribution/Client/HttpUtils.hs

-{-# OPTIONS -cpp #-}
 -----------------------------------------------------------------------------
 -- | Separate module for HTTP actions, using a proxy server if one exists 
 -----------------------------------------------------------------------------

cabal-install/Distribution/Client/Init.hs

@@ -42,11 +42,7 @@ import Data.Traversable
 import Control.Applicative
   ( (<$>) )
 import Control.Monad
-  ( when, unless )
-#if MIN_VERSION_base(3,0,0)
-import Control.Monad
-  ( (>=>), join )
-#endif
+  ( when, unless, (>=>), join )
 import Control.Arrow
   ( (&&&), (***) )
 
@@ -765,8 +761,3 @@ message :: InitFlags -> String -> IO ()
 message (InitFlags{quiet = Flag True}) _ = return ()
 message _ s = putStrLn s
 
-#if MIN_VERSION_base(3,0,0)
-#else
-(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
-f >=> g     = \x -> f x >>= g
-#endif

cabal-install/Distribution/Client/Init/Heuristics.hs

-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Init.Heuristics
@@ -34,9 +33,7 @@ import Distribution.Client.Types ( packageDescription, SourcePackageDb(..) )
 import Control.Applicative ( pure, (<$>), (<*>) )
 import Control.Monad (liftM )
 import Data.Char   ( isUpper, isLower, isSpace )
-#if MIN_VERSION_base(3,0,3)
 import Data.Either ( partitionEithers )
-#endif
 import Data.List   ( isPrefixOf )
 import Data.Maybe  ( mapMaybe, catMaybes, maybeToList )
 import Data.Monoid ( mempty, mappend )
@@ -222,11 +219,3 @@ test db testProjectRoot = do
   print $ knownCategories db
 -}
 
-#if MIN_VERSION_base(3,0,3)
-#else
-partitionEithers :: [Either a b] -> ([a],[b])
-partitionEithers = foldr (either left right) ([],[])
- where
-   left  a (l, r) = (a:l, r)
-   right a (l, r) = (l, a:r)
-#endif

cabal-install/Distribution/Client/Init/Types.hs

-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Init.Types
@@ -153,12 +152,3 @@ instance Text Category where
   disp  = Disp.text . show
   parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ]
 
-#if MIN_VERSION_base(3,0,0)
-#else
--- Compat instance for ghc-6.6 era
-instance Monoid a => Monoid (Maybe a) where
-  mempty = Nothing
-  Nothing `mappend` m = m
-  m `mappend` Nothing = m
-  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
-#endif

cabal-install/Distribution/Client/Install.hs

-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Install
@@ -34,15 +33,10 @@ import Data.Maybe
          ( isJust, fromMaybe, maybeToList )
 import Control.Exception as Exception
          ( bracket, handleJust )
-#if MIN_VERSION_base(4,0,0)
 import Control.Exception as Exception
          ( Exception(toException), catches, Handler(Handler), IOException )
 import System.Exit
          ( ExitCode )
-#else
-import Control.Exception as Exception
-         ( Exception(IOException, ExitException) )
-#endif
 import Distribution.Compat.Exception
          ( SomeException, catchIO, catchExit )
 import Control.Monad
@@ -657,11 +651,7 @@ storeDetailedBuildReports verbosity logsDir reports = sequence_
       warn verbosity $ "Missing log file for build report: "
                     ++ fromMaybe ""  (ioeGetFileName ioe)
 
-#if MIN_VERSION_base(4,0,0)
     missingFile ioe
-#else
-    missingFile (IOException ioe)
-#endif
       | isDoesNotExistError ioe  = Just ioe
     missingFile _                = Nothing
 
@@ -1197,7 +1187,6 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
 -- helper
 onFailure :: (SomeException -> BuildFailure) -> IO BuildResult -> IO BuildResult
 onFailure result action =
-#if MIN_VERSION_base(4,0,0)
   action `catches`
     [ Handler $ \ioe  -> handler (ioe  :: IOException)
     , Handler $ \exit -> handler (exit :: ExitCode)
@@ -1205,11 +1194,6 @@ onFailure result action =
   where
     handler :: Exception e => e -> IO BuildResult
     handler = return . Left . result . toException
-#else
-  action
-    `catchIO`   (return . Left . result . IOException)
-    `catchExit` (return . Left . result . ExitException)
-#endif
 
 
 -- ------------------------------------------------------------

cabal-install/Distribution/Client/InstallSymlink.hs

-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -cpp #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp  #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.InstallSymlink

cabal-install/Distribution/Client/Win32SelfUpgrade.hs

 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp -fffi #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Win32SelfUpgrade

cabal-install/Distribution/Compat/Env.hs

@@ -18,7 +18,6 @@ module Distribution.Compat.Env (
   lookupEnv, setEnv
 ) where
 
-#ifdef __GLASGOW_HASKELL__
 #ifdef mingw32_HOST_OS
 import GHC.Windows
 import Foreign.Safe
@@ -37,14 +36,7 @@ import System.Environment (lookupEnv)
 import Distribution.Compat.Exception (catchIO)
 #endif
 
-#if __GLASGOW_HASKELL__ > 611
 import System.Posix.Internals ( withFilePath )
-#endif /* __GLASGOW_HASKELL__ > 611 */
-
-#if __GLASGOW_HASKELL__ <= 611
-withFilePath :: FilePath -> (CString -> IO a) -> IO a
-withFilePath = withCString
-#endif /* __GLASGOW_HASKELL__ <= 611 */
 
 #if !MIN_VERSION_base(4,6,0)
 -- | @lookupEnv var@ returns the value of the environment variable @var@, or
@@ -69,7 +61,6 @@ eRROR_ENVVAR_NOT_FOUND :: DWORD
 eRROR_ENVVAR_NOT_FOUND = 203
 
 #endif /* mingw32_HOST_OS */
-#endif /* __GLASGOW_HASKELL__ */
 
 -- | @setEnv name value@ sets the specified environment variable to @value@.
 --
@@ -86,7 +77,6 @@ setEnv key value_
     value = takeWhile (/= '\NUL') value_
 
 setEnv_ :: String -> String -> IO ()
-#ifdef __GLASGOW_HASKELL__
 
 #ifdef mingw32_HOST_OS
 setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do
@@ -106,7 +96,3 @@ foreign import ccall unsafe "setenv"
    c_setenv :: CString -> CString -> CInt -> IO CInt
 #endif /* mingw32_HOST_OS */
 
-#else
--- setEnv is a no-op on non-GHC compilers since we depend on GHC.Windows.
-setEnv_ _key _value = return ()
-#endif /* __GLASGOW_HASKELL__ */

cabal-install/Distribution/Compat/Exception.hs

-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -cpp #-}
-{-# OPTIONS_NHC98 -cpp #-}
-{-# OPTIONS_JHC -fcpp #-}
 {-# OPTIONS_HADDOCK hide #-}
 module Distribution.Compat.Exception (
   SomeException,
@@ -14,43 +10,19 @@ module Distribution.Compat.Exception (
 
 import System.Exit
 import qualified Control.Exception as Exception
-#if MIN_VERSION_base(4,0,0)
 import Control.Exception (SomeException)
-#else
-import Control.Exception (Exception)
-type SomeException = Exception
-#endif
 
 onException :: IO a -> IO b -> IO a
-#if MIN_VERSION_base(4,0,0)
 onException = Exception.onException
-#else
-onException io what = io `Exception.catch` \e -> do what
-                                                    Exception.throw e
-#endif
 
 throwIOIO :: Exception.IOException -> IO a
-#if MIN_VERSION_base(4,0,0)
 throwIOIO = Exception.throwIO
-#else
-throwIOIO = Exception.throwIO . Exception.IOException
-#endif
 
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
-#if MIN_VERSION_base(4,0,0)
 catchIO = Exception.catch
-#else
-catchIO = Exception.catchJust Exception.ioErrors
-#endif
 
 handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
 handleIO = flip catchIO
 
 catchExit :: IO a -> (ExitCode -> IO a) -> IO a
-#if MIN_VERSION_base(4,0,0)
 catchExit = Exception.catch
-#else
-catchExit = Exception.catchJust exitExceptions
-    where exitExceptions (Exception.ExitException ee) = Just ee
-          exitExceptions _                            = Nothing
-#endif

cabal-install/Distribution/Compat/FilePerms.hs

@@ -12,13 +12,8 @@ import System.Posix.Internals
          ( c_chmod )
 import Foreign.C
          ( withCString )
-#if MIN_VERSION_base(4,0,0)
 import Foreign.C
          ( throwErrnoPathIfMinus1_ )
-#else
-import Foreign.C
-         ( throwErrnoIfMinus1_ )
-#endif
 #endif /* mingw32_HOST_OS */
 
 setFileOrdinary,  setFileExecutable  :: FilePath -> IO ()
@@ -29,11 +24,7 @@ setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x
 setFileMode :: FilePath -> FileMode -> IO ()
 setFileMode name m =
   withCString name $ \s ->
-#if __GLASGOW_HASKELL__ >= 608
     throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
-#else
-    throwErrnoIfMinus1_                   name (c_chmod s m)
-#endif
 #else
 setFileOrdinary   _ = return ()
 setFileExecutable _ = return ()