[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