[commit: packages/directory] master: Drop support for Hugs (1df36f9)
git at git.haskell.org
git at git.haskell.org
Sat Apr 16 19:13:34 UTC 2016
Repository : ssh://git@git.haskell.org/directory
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/1df36f9b6b82d246bf62631ff4555a82a34fc2c2/directory
>---------------------------------------------------------------
commit 1df36f9b6b82d246bf62631ff4555a82a34fc2c2
Author: Phil Ruffwind <rf at rufflewind.com>
Date: Thu Apr 14 05:34:46 2016 -0400
Drop support for Hugs
It is highly probable that the library has not actually worked on Hugs
for a long time due to bit rot and lack of testing, so no-one should
miss it, really.
>---------------------------------------------------------------
1df36f9b6b82d246bf62631ff4555a82a34fc2c2
System/Directory.hs | 32 --------------------------------
cbits/directory.c | 4 ----
changelog.md | 2 ++
3 files changed, 2 insertions(+), 36 deletions(-)
diff --git a/System/Directory.hs b/System/Directory.hs
index 44012d6..744a1a9 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -125,10 +125,6 @@ import System.IO.Error
, modifyIOError
, tryIOError )
-#ifdef __HUGS__
-import Hugs.Directory
-#endif /* __HUGS__ */
-
import Foreign
{-# CFILES cbits/directory.c #-}
@@ -142,8 +138,6 @@ import Data.Time.Clock.POSIX
#endif
)
-#ifdef __GLASGOW_HASKELL__
-
import GHC.IO.Exception ( IOErrorType(InappropriateType) )
#ifdef mingw32_HOST_OS
@@ -164,8 +158,6 @@ import Foreign.C (throwErrnoPathIfMinus1_)
import System.Posix.Internals ( withFilePath )
#endif
-#endif /* __GLASGOW_HASKELL__ */
-
import System.Directory.Internal
#ifdef mingw32_HOST_OS
@@ -256,8 +248,6 @@ The operation may fail with:
-}
-#ifdef __GLASGOW_HASKELL__
-
getPermissions :: FilePath -> IO Permissions
getPermissions name = do
#ifdef mingw32_HOST_OS
@@ -416,14 +406,6 @@ createDirectory path = do
Posix.createDirectory path 0o777
#endif
-#else /* !__GLASGOW_HASKELL__ */
-
-copyPermissions :: FilePath -> FilePath -> IO ()
-copyPermissions fromFPath toFPath
- = getPermissions fromFPath >>= setPermissions toFPath
-
-#endif
-
-- | @'createDirectoryIfMissing' parents dir@ creates a new directory
-- @dir@ if it doesn\'t exist. If the first argument is 'True'
-- the function will also create all parent directories if they are missing.
@@ -475,8 +457,6 @@ createDirectoryIfMissing create_parents path0
isDir = (Posix.isDirectory <$> Posix.getFileStatus dir)
#endif
-#if __GLASGOW_HASKELL__
-
-- | * @'NotDirectory'@: not a directory.
-- * @'Directory'@: a true directory (not a symbolic link).
-- * @'DirectoryLink'@: a directory symbolic link (only exists on Windows).
@@ -555,8 +535,6 @@ removeDirectory path =
Posix.removeDirectory path
#endif
-#endif
-
-- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
-- together with its contents and subdirectories. Within this directory,
-- symbolic links are removed without affecting their targets.
@@ -597,7 +575,6 @@ removeContentsRecursive path =
mapM_ removePathRecursive [path </> x | x <- cont]
removeDirectory path
-#if __GLASGOW_HASKELL__
{- |'removeFile' /file/ removes the directory entry for an existing file
/file/, where /file/ is not itself a directory. The
implementation may specify additional constraints which must be
@@ -783,8 +760,6 @@ renameFile opath npath = (`ioeSetLocation` "renameFile") `modifyIOError` do
errIsDir path = ioError . (`ioeSetErrorString` "is a directory") $
mkIOError InappropriateType "" Nothing (Just path)
-#endif /* __GLASGOW_HASKELL__ */
-
-- | Copy a file with its permissions. If the destination file already exists,
-- it is replaced atomically. Neither path may refer to an existing
-- directory. No exceptions are thrown if the permissions could not be
@@ -1183,7 +1158,6 @@ findFileWithIn f name d = do
else return Nothing
else return Nothing
-#ifdef __GLASGOW_HASKELL__
-- | Similar to 'listDirectory', but always includes the special entries (@.@
-- and @..@). (This applies to Windows as well.)
--
@@ -1260,9 +1234,6 @@ listDirectory path =
(filter f) <$> (getDirectoryContents path)
where f filename = filename /= "." && filename /= ".."
-#endif /* __GLASGOW_HASKELL__ */
-
-
-- | Obtain the current working directory as an absolute path.
--
-- In a multithreaded program, the current working directory is a global state
@@ -1290,7 +1261,6 @@ listDirectory path =
-- * 'UnsupportedOperation'
-- The operating system has no notion of current working directory.
--
-#ifdef __GLASGOW_HASKELL__
getCurrentDirectory :: IO FilePath
getCurrentDirectory =
modifyIOError (`ioeSetLocation` "getCurrentDirectory") $
@@ -1603,8 +1573,6 @@ posixToWindowsTime t = Win32.FILETIME $
truncate (t * 10000000 + windowsPosixEpochDifference)
#endif
-#endif /* __GLASGOW_HASKELL__ */
-
#ifdef mingw32_HOST_OS
withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
withFileStatus loc name f = do
diff --git a/cbits/directory.c b/cbits/directory.c
index 55cece2..7f853f1 100644
--- a/cbits/directory.c
+++ b/cbits/directory.c
@@ -1,4 +1,3 @@
-#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
/*
* (c) The University of Glasgow 2002
*
@@ -8,6 +7,3 @@
#define INLINE
#include "HsDirectory.h"
-
-#endif
-
diff --git a/changelog.md b/changelog.md
index d047bd4..26fa808 100644
--- a/changelog.md
+++ b/changelog.md
@@ -17,6 +17,8 @@ Changelog for the [`directory`][1] package
* Add `isSymbolicLink`
+ * Drop support for Hugs.
+
## 1.2.5.1 (February 2015)
* Improve error message of `getCurrentDirectory` when the current working
More information about the ghc-commits
mailing list