diff --git a/Cabal.cabal b/Cabal.cabal index 3e0db0ea652ab5a76ac85ef5cda78e1362ff1604..4d93ee75d2da05d1cf58421ece896fd9a7f86318 100644 --- a/Cabal.cabal +++ b/Cabal.cabal @@ -83,10 +83,6 @@ Library Other-Modules: Distribution.GetOpt, - Distribution.Compat.Map, - Distribution.Compat.Directory, - Distribution.Compat.Exception, - Distribution.Compat.RawSystem, Distribution.Compat.TempFile Extensions: CPP diff --git a/Distribution/Compat/Directory.hs b/Distribution/Compat/Directory.hs deleted file mode 100644 index 522b48cd803d825baada2c0c1d25e198fb20b747..0000000000000000000000000000000000000000 --- a/Distribution/Compat/Directory.hs +++ /dev/null @@ -1,198 +0,0 @@ -{-# OPTIONS -cpp #-} --- #hide -module Distribution.Compat.Directory ( - module System.Directory, -#if (__GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ <= 602) - findExecutable, copyFile, getHomeDirectory, createDirectoryIfMissing, - removeDirectoryRecursive, getTemporaryDirectory, -#endif - getDirectoryContentsWithoutSpecial - ) where - -#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 604 -#if __GLASGOW_HASKELL__ < 603 -#include "config.h" -#else -#include "ghcconfig.h" -#endif -#endif - -#if !(__GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ <= 602) - -import System.Directory - -#else /* to end of file... */ - -import System.Environment ( getEnv ) -import System.FilePath -import System.IO -import Foreign -import System.Directory -import Distribution.Compat.Exception (bracket) -import Control.Monad (when, unless) -#if !(mingw32_HOST_OS || mingw32_TARGET_OS) -import System.Posix (getFileStatus,setFileMode,fileMode,accessTime, - modificationTime,setFileTimes) -#endif -import Data.List ( scanl1 ) - -findExecutable :: String -> IO (Maybe FilePath) -findExecutable binary = do - path <- getEnv "PATH" - search (splitSearchPath path) - where - search :: [FilePath] -> IO (Maybe FilePath) - search [] = return Nothing - search (d:ds) = do - let path = d </> binary <.> exeSuffix - b <- doesFileExist path - if b then return (Just path) - else search ds - -exeSuffix :: String -#if mingw32_HOST_OS || mingw32_TARGET_OS -exeSuffix = "exe" -#else -exeSuffix = "" -#endif - -copyPermissions :: FilePath -> FilePath -> IO () -#if !(mingw32_HOST_OS || mingw32_TARGET_OS) -copyPermissions src dest - = do srcStatus <- getFileStatus src - setFileMode dest (fileMode srcStatus) -#else -copyPermissions src dest - = getPermissions src >>= setPermissions dest -#endif - - -copyFileTimes :: FilePath -> FilePath -> IO () -#if !(mingw32_HOST_OS || mingw32_TARGET_OS) -copyFileTimes src dest - = do st <- getFileStatus src - let atime = accessTime st - mtime = modificationTime st - setFileTimes dest atime mtime -#else -copyFileTimes src dest - = return () -#endif - --- |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" -#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600)) - | otherwise = do readFile src >>= writeFile dest - try (copyPermissions src dest) - return () -#else - | otherwise = bracket (openBinaryFile src ReadMode) hClose $ \hSrc -> - bracket (openBinaryFile dest WriteMode) hClose $ \hDest -> - do allocaBytes bufSize $ \buffer -> copyContents hSrc hDest buffer - try (copyPermissions src dest) - try (copyFileTimes src dest) - 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 - -getHomeDirectory :: IO FilePath -getHomeDirectory = getEnv "HOME" - -createDirectoryIfMissing :: Bool -- ^ Create its parents too? - -> FilePath -- ^ The path to the directory you want to make - -> IO () -createDirectoryIfMissing parents file = do - b <- doesDirectoryExist file - case (b,parents, file) of - (_, _, "") -> return () - (True, _, _) -> return () - (_, True, _) -> mapM_ (createDirectoryIfMissing False) (pathParents file) - (_, False, _) -> createDirectory file - -pathParents = scanl1 (</>) . splitDirectories - -- > scanl1 (</>) (splitDirectories "/a/b/c") - -- ["/","/a","/a/b","/a/b/c"] - -removeDirectoryRecursive :: FilePath -> IO () -removeDirectoryRecursive startLoc = do - cont <- getDirectoryContentsWithoutSpecial startLoc - mapM_ (rm . (startLoc </>)) cont - removeDirectory startLoc - where - rm :: FilePath -> IO () - rm f = do temp <- try (removeFile f) - case temp of - Left e -> do isDir <- doesDirectoryExist f - -- If f is not a directory, re-throw the error - unless isDir $ ioError e - removeDirectoryRecursive f - Right _ -> return () - -{- | Returns the current directory for temporary files. - -On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@ -environment variable or \"\/tmp\" if the variable isn\'t defined. -On Windows, the function checks for the existence of environment variables in -the following order and uses the first path found: - -* -TMP environment variable. - -* -TEMP environment variable. - -* -USERPROFILE environment variable. - -* -The Windows directory - -The operation may fail with: - -* 'UnsupportedOperation' -The operating system has no notion of temporary directory. - -The function doesn\'t verify whether the path exists. --} -getTemporaryDirectory :: IO FilePath -getTemporaryDirectory = do -#if defined(mingw32_HOST_OS) - allocaBytes long_path_size $ \pPath -> do - r <- c_GetTempPath (fromIntegral long_path_size) pPath - peekCString pPath -#else - catch (getEnv "TMPDIR") (\ex -> return "/tmp") -#endif - -#if defined(mingw32_HOST_OS) -foreign import ccall unsafe "__hscore_getFolderPath" - c_SHGetFolderPath :: Ptr () - -> CInt - -> Ptr () - -> CInt - -> CString - -> IO CInt -foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt -foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt -foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt -foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt - -foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt - -raiseUnsupported loc = - ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing) - -#endif - -#endif - -getDirectoryContentsWithoutSpecial :: FilePath -> IO [FilePath] -getDirectoryContentsWithoutSpecial = - fmap (filter (not . flip elem [".", ".."])) . getDirectoryContents - diff --git a/Distribution/Compat/Exception.hs b/Distribution/Compat/Exception.hs deleted file mode 100644 index d16512869163a9b7945bc2202a092203daf41517..0000000000000000000000000000000000000000 --- a/Distribution/Compat/Exception.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# OPTIONS -cpp #-} --- #hide -module Distribution.Compat.Exception (bracket,finally) where - -#ifdef __NHC__ -import System.IO.Error (catch, ioError) -import IO (bracket) -#else -import Control.Exception (bracket,finally) -#endif - -#ifdef __NHC__ -finally :: IO a -> IO b -> IO a -finally thing after = bracket (return ()) (const after) (const thing) -#endif diff --git a/Distribution/Compat/Map.hs b/Distribution/Compat/Map.hs deleted file mode 100644 index 9082e65cc73924a6c834e9c93b4059d4bd23e006..0000000000000000000000000000000000000000 --- a/Distribution/Compat/Map.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# OPTIONS -cpp #-} --- #hide -module Distribution.Compat.Map ( - Map, - member, lookup, findWithDefault, - empty, - insert, insertWith, - update, - union, unionWith, unions, - difference, - elems, keys, - fromList, fromListWith, - toAscList -) where - -import Prelude hiding ( lookup ) - -#if __GLASGOW_HASKELL__ >= 603 || !__GLASGOW_HASKELL__ -import Data.Map -#else -import Data.FiniteMap - -type Map k a = FiniteMap k a - -instance Functor (FiniteMap k) where - fmap f = mapFM (const f) - -member :: Ord k => k -> Map k a -> Bool -member = elemFM - -lookup :: Ord k => k -> Map k a -> Maybe a -lookup = flip lookupFM - -findWithDefault :: Ord k => a -> k -> Map k a -> a -findWithDefault a k m = lookupWithDefaultFM m a k - -empty :: Map k a -empty = emptyFM - -insert :: Ord k => k -> a -> Map k a -> Map k a -insert k a m = addToFM m k a - --- This might be able to use delFromFM, but I'm confused by the --- IF_NOT_GHC(delFromFM COMMA) --- in the Data.FiniteMap export list in ghc 6.2. -delete :: Ord k => k -> Map k a -> Map k a -delete k m = delListFromFM m [k] - -insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a -insertWith c k a m = addToFM_C (flip c) m k a - -update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a -update f k m = case lookup k m of - Nothing -> m - Just a -> case f a of - Nothing -> delete k m - Just a' -> insert k a' m - -union :: Ord k => Map k a -> Map k a -> Map k a -union = flip plusFM - -unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a -unionWith c l r = plusFM_C (flip c) r l - -unions :: Ord k => [Map k a] -> Map k a -unions = foldl (flip plusFM) emptyFM - -difference :: Ord k => Map k a -> Map k b -> Map k a -difference m1 m2 = delListFromFM m1 (keys m2) - -- minusFM wasn't polymorphic enough in GHC 6.2.x - -elems :: Map k a -> [a] -elems = eltsFM - -keys :: Map k a -> [k] -keys = keysFM - -fromList :: Ord k => [(k,a)] -> Map k a -fromList = listToFM - -fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a -fromListWith c = addListToFM_C (flip c) emptyFM - -toAscList :: Map k a -> [(k,a)] -toAscList = fmToList -#endif diff --git a/Distribution/Compat/RawSystem.hs b/Distribution/Compat/RawSystem.hs deleted file mode 100644 index 4a804c0112134631f67ff1db721892934cfbc229..0000000000000000000000000000000000000000 --- a/Distribution/Compat/RawSystem.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# OPTIONS -cpp #-} --- #hide -module Distribution.Compat.RawSystem (rawSystem) where - -#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 602 -import Data.List (intersperse) -import System.Cmd (system) -import System.Exit (ExitCode) -#else -import System.Cmd (rawSystem) -#endif - -#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 602 -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 diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs index 510e5fcddda3789654975219b145d017f0ee45db..cfd5845d0424f03a4761a61b9be2a9068dac8e0e 100644 --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -106,13 +106,13 @@ import Distribution.Verbosity import Language.Haskell.Extension -- Base import System.Environment(getArgs,getProgName) -import System.Directory(removeFile, doesFileExist, doesDirectoryExist) +import System.Directory(removeFile, doesFileExist, + doesDirectoryExist, removeDirectoryRecursive) import Distribution.License import Control.Monad (when, unless) import Data.List (intersperse, unionBy) -import Distribution.Compat.Directory(removeDirectoryRecursive) import System.FilePath((</>)) #ifdef DEBUG diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs index 7445d296691e1b80df58ebeeb3a8f88ba7de7236..e4265b4ea47291b25e98eca2df8584f3f36f1fc8 100644 --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -66,8 +66,6 @@ module Distribution.Simple.Configure (configure, #endif #endif -import Distribution.Compat.Directory - ( createDirectoryIfMissing ) import Distribution.Simple.Compiler ( CompilerFlavor(..), Compiler(..), compilerVersion, showCompilerId , unsupportedExtensions, PackageDB(..) ) @@ -123,7 +121,7 @@ import Data.List import Data.Maybe ( fromMaybe, isNothing ) import System.Directory - ( doesFileExist, getModificationTime ) + ( doesFileExist, getModificationTime, createDirectoryIfMissing ) import System.Environment ( getProgName ) import System.Exit diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs index 89e7b8d487359decc66e71732d065a9d54af6c5a..1fd579af8606d01784e7d3bd66ead9aa1e3924a0 100644 --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -86,8 +86,8 @@ import Control.Monad ( unless, when ) import Data.Char import Data.List ( nub, isPrefixOf ) import System.Directory ( removeFile, renameFile, - getDirectoryContents, doesFileExist ) -import Distribution.Compat.Directory ( getTemporaryDirectory ) + getDirectoryContents, doesFileExist, + getTemporaryDirectory ) import Distribution.Compat.TempFile ( withTempFile ) import System.FilePath ( (</>), (<.>), takeExtension, takeDirectory, replaceExtension, splitExtension ) diff --git a/Distribution/Simple/GHC/PackageConfig.hs b/Distribution/Simple/GHC/PackageConfig.hs index 23b756252534b666cc8f66b96ad5cf2398ae4c32..843da979a1a8a4105f84960265081e2e961b5369 100644 --- a/Distribution/Simple/GHC/PackageConfig.hs +++ b/Distribution/Simple/GHC/PackageConfig.hs @@ -35,9 +35,9 @@ import IO (try) #endif import Control.Monad(unless) import Text.PrettyPrint.HughesPJ -import System.Directory (doesFileExist, getPermissions, Permissions (..)) +import System.Directory (doesFileExist, getPermissions, Permissions (..), + getHomeDirectory) import System.FilePath ((</>)) -import Distribution.Compat.Directory (getHomeDirectory) -- |Where ghc versions < 6.3 keeps the --user files. -- |return the file, whether it exists, and whether it's readable diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs index b967781095ab34d18a25ce89923616b19dbbd647..9a32f68b7c59e103de6cce393465a3e0c06a0d01 100644 --- a/Distribution/Simple/Haddock.hs +++ b/Distribution/Simple/Haddock.hs @@ -73,14 +73,14 @@ import Distribution.Simple.Utils (rawSystemStdout) import Distribution.Verbosity import Language.Haskell.Extension -- Base -import System.Directory(removeFile, doesFileExist) +import System.Directory(removeFile, doesFileExist, + removeDirectoryRecursive, copyFile) import Control.Monad (liftM, when, unless, join) import Data.Maybe ( isJust, catMaybes, fromJust ) import Data.Char (isSpace) import Data.List (nub) -import Distribution.Compat.Directory(removeDirectoryRecursive, copyFile) import System.FilePath((</>), (<.>), splitFileName, splitExtension, replaceExtension) import Distribution.Version diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs index 25b8f746c94a5c6944d9676694b26e14917b1f79..2e5666d8967b5830e1d0f15c8fcd6b6016ce20cb 100644 --- a/Distribution/Simple/Hugs.hs +++ b/Distribution/Simple/Hugs.hs @@ -65,8 +65,6 @@ import Distribution.Simple.Utils( createDirectoryIfMissingVerbose, dotToSep, smartCopySources, findFile, dllExtension ) import Language.Haskell.Extension ( Extension(..) ) -import Distribution.Compat.Directory - ( copyFile, removeDirectoryRecursive ) import System.FilePath ( (</>), takeExtension, (<.>), searchPathSeparator, normalise, takeDirectory ) import Distribution.System @@ -83,7 +81,8 @@ import IO ( try ) #endif import Data.List ( nub, sort, isSuffixOf ) import System.Directory ( Permissions(..), getPermissions, - setPermissions ) + setPermissions, copyFile, + removeDirectoryRecursive ) -- ----------------------------------------------------------------------------- diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs index cc17445ca2dcc7a796df8a28633e2a5fa62fe6e2..774e2ebe10a3f0b4c910e9368004efefca5b4983 100644 --- a/Distribution/Simple/Install.hs +++ b/Distribution/Simple/Install.hs @@ -74,7 +74,7 @@ import qualified Distribution.Simple.JHC as JHC import qualified Distribution.Simple.Hugs as Hugs import Control.Monad (when, unless) -import Distribution.Compat.Directory(doesDirectoryExist, doesFileExist) +import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath(takeDirectory, (</>), isAbsolute) import Distribution.Verbosity diff --git a/Distribution/Simple/Program.hs b/Distribution/Simple/Program.hs index 77fd63f19ce4625e0055beb3d1da81447b3de21a..0f9398ddc73633ea527c050d371345e471b71067 100644 --- a/Distribution/Simple/Program.hs +++ b/Distribution/Simple/Program.hs @@ -84,15 +84,14 @@ module Distribution.Simple.Program ( , pkgConfigProgram ) where -import qualified Distribution.Compat.Map as Map -import Distribution.Compat.Directory (findExecutable) +import qualified Data.Map as Map import Distribution.Compat.TempFile (withTempFile) import Distribution.Simple.Utils (die, debug, warn, rawSystemExit, rawSystemStdout, rawSystemStdout') import Distribution.Version (Version(..), readVersion, showVersion, VersionRange(..), withinRange, showVersionRange) import Distribution.Verbosity -import System.Directory (doesFileExist, removeFile) +import System.Directory (doesFileExist, removeFile, findExecutable) import System.FilePath (dropExtension) import System.IO.Error (try) import Control.Monad (join, foldM) diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs index a70c2f7099b49944c8ae412afc0c20c309aff766..22f4d9368a7e75df72ca52aa44e1fcdd73fa3f27 100644 --- a/Distribution/Simple/Register.hs +++ b/Distribution/Simple/Register.hs @@ -86,14 +86,12 @@ import Distribution.Simple.GHC.PackageConfig (mkGHCPackageConfig, showGHCPackage import qualified Distribution.Simple.GHC.PackageConfig as GHC (localPackageConfig, canWriteLocalPackageConfig, maybeCreateLocalPackageConfig) import Distribution.System -import Distribution.Compat.Directory - (removeDirectoryRecursive, - setPermissions, getPermissions, Permissions(executable) - ) import System.FilePath ((</>), (<.>), isAbsolute) - -import System.Directory( removeFile, getCurrentDirectory) +import System.Directory (removeFile, getCurrentDirectory, + removeDirectoryRecursive, + setPermissions, getPermissions, + Permissions(executable)) import System.IO.Error (try) import Control.Monad (when) diff --git a/Distribution/Simple/SetupWrapper.hs b/Distribution/Simple/SetupWrapper.hs index be30b66151246c09e7727cbd3165acc4f3b55e8a..782427b7616780acf8c8900863e853aa289f413d 100644 --- a/Distribution/Simple/SetupWrapper.hs +++ b/Distribution/Simple/SetupWrapper.hs @@ -33,7 +33,7 @@ import Distribution.Simple.Program ( ProgramConfiguration, import Distribution.Simple.GHC (ghcVerbosityOptions) import Distribution.GetOpt import System.Directory -import Distribution.Compat.Exception ( finally ) +import Control.Exception ( finally ) import Distribution.Verbosity import System.FilePath ((</>), (<.>)) import Control.Monad ( when, unless ) diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs index 7b51b9b978f966d863d028c45a135b0241744653..d9d4054b13fe9d175667fd55d5743915e96628f1 100644 --- a/Distribution/Simple/SrcDist.hs +++ b/Distribution/Simple/SrcDist.hs @@ -79,7 +79,7 @@ import Control.Monad(when, unless) import Data.Char (isSpace, toLower) import Data.List (isPrefixOf) import System.Time (getClockTime, toCalendarTime, CalendarTime(..)) -import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist, +import System.Directory (doesFileExist, doesDirectoryExist, getCurrentDirectory, removeDirectoryRecursive) import Distribution.Verbosity import System.FilePath ((</>), takeDirectory, isAbsolute) diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs index 6312f629e836a43576b864fb05124e5afb8cbc8b..cc54c69af6194a4b5b487ef3124fb1028a2c465f 100644 --- a/Distribution/Simple/Utils.hs +++ b/Distribution/Simple/Utils.hs @@ -97,22 +97,22 @@ import System.Directory , doesFileExist, removeFile ) import System.Environment ( getProgName ) +import System.Cmd + ( rawSystem ) import System.Exit ( exitWith, ExitCode(..) ) import System.FilePath ( takeDirectory, takeExtension, (</>), (<.>), pathSeparator ) +import System.Directory + ( copyFile, findExecutable, createDirectoryIfMissing + , getTemporaryDirectory ) import System.IO ( hPutStrLn, stderr, hFlush, stdout, openFile, IOMode(WriteMode) ) import System.IO.Error ( try ) - -import Distribution.Compat.Directory - ( copyFile, findExecutable, createDirectoryIfMissing - , getDirectoryContentsWithoutSpecial, getTemporaryDirectory ) -import Distribution.Compat.RawSystem - ( rawSystem ) -import Distribution.Compat.Exception +import Control.Exception ( bracket ) + import Distribution.System ( OS(..), os ) import Distribution.Version @@ -446,6 +446,9 @@ copyDirectoryRecursiveVerbose verbosity srcDir destDir = do getDirectoryContentsWithoutSpecial src >>= mapM_ cp in aux srcDir destDir + where getDirectoryContentsWithoutSpecial = + fmap (filter (not . flip elem [".", ".."])) + . getDirectoryContents