diff --git a/patches/Unixutils-1.54.1.patch b/patches/Unixutils-1.54.1.patch deleted file mode 100644 index 8e4f8011f81a306cdf9b4ef95384a80f18067cd7..0000000000000000000000000000000000000000 --- a/patches/Unixutils-1.54.1.patch +++ /dev/null @@ -1,23 +0,0 @@ -diff --git a/System/Unix/Chroot.hs b/System/Unix/Chroot.hs -index 06bf3dd..12de580 100644 ---- a/System/Unix/Chroot.hs -+++ b/System/Unix/Chroot.hs -@@ -1,4 +1,4 @@ --{-# LANGUAGE ForeignFunctionInterface #-} -+{-# LANGUAGE CPP, ForeignFunctionInterface #-} - -- | This module, except for useEnv, is copied from the build-env package. - module System.Unix.Chroot - ( fchroot -@@ -45,7 +45,11 @@ chroot fp = withCString fp $ \cfp -> throwErrnoIfMinus1_ "chroot" (c_chroot cfp) - fchroot :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a - fchroot path action = - do origWd <- liftIO $ getWorkingDirectory -- rootFd <- liftIO $ openFd "/" ReadOnly Nothing defaultFileFlags -+ rootFd <- liftIO $ openFd "/" ReadOnly -+#if !(MIN_VERSION_unix(2,8,0)) -+ Nothing -+#endif -+ defaultFileFlags - liftIO $ chroot path - liftIO $ changeWorkingDirectory "/" - action `finally` (liftIO $ breakFree origWd rootFd) diff --git a/patches/bytestring-mmap-0.2.2.patch b/patches/bytestring-mmap-0.2.2.patch deleted file mode 100644 index 50f12c7d38c55325a4326b0dda435705f24f719f..0000000000000000000000000000000000000000 --- a/patches/bytestring-mmap-0.2.2.patch +++ /dev/null @@ -1,40 +0,0 @@ -diff --git a/System/IO/Posix/MMap.hs b/System/IO/Posix/MMap.hs -index adf71e2..3525c84 100644 ---- a/System/IO/Posix/MMap.hs -+++ b/System/IO/Posix/MMap.hs -@@ -1,4 +1,4 @@ --{-# LANGUAGE ForeignFunctionInterface #-} -+{-# LANGUAGE CPP, ForeignFunctionInterface #-} - -------------------------------------------------------------------- - -- | - -- Module : System.IO.Posix.MMap -@@ -98,7 +98,11 @@ import System.Posix - -- - unsafeMMapFile :: FilePath -> IO ByteString - unsafeMMapFile f = do -- fd <- openFd f ReadOnly Nothing defaultFileFlags -+ fd <- openFd f ReadOnly -+#if !(MIN_VERSION_unix(2,8,0)) -+ Nothing -+#endif -+ defaultFileFlags - always (closeFd fd) $ do - stat <- getFdStatus fd - let size = fromIntegral (fileSize stat) -diff --git a/System/IO/Posix/MMap/Lazy.hs b/System/IO/Posix/MMap/Lazy.hs -index 16c9539..ffb7535 100644 ---- a/System/IO/Posix/MMap/Lazy.hs -+++ b/System/IO/Posix/MMap/Lazy.hs -@@ -91,7 +91,11 @@ import System.Posix - -- - unsafeMMapFile :: FilePath -> IO ByteString - unsafeMMapFile path = do -- fd <- openFd path ReadOnly Nothing defaultFileFlags -+ fd <- openFd path ReadOnly -+#if !(MIN_VERSION_unix(2,8,0)) -+ Nothing -+#endif -+ defaultFileFlags - always (closeFd fd) $ do - stat <- getFdStatus fd - let size = fromIntegral (fileSize stat) diff --git a/patches/crypto-random-0.0.9.patch b/patches/crypto-random-0.0.9.patch deleted file mode 100644 index 5c4c7554af243c9484a90b557a250da495995b0b..0000000000000000000000000000000000000000 --- a/patches/crypto-random-0.0.9.patch +++ /dev/null @@ -1,38 +0,0 @@ -diff --git a/Crypto/Random/Entropy/Unix.hs b/Crypto/Random/Entropy/Unix.hs -index 42e7d8c..7777952 100644 ---- a/Crypto/Random/Entropy/Unix.hs -+++ b/Crypto/Random/Entropy/Unix.hs -@@ -5,6 +5,7 @@ - -- Stability : experimental - -- Portability : Good - -- -+{-# LANGUAGE CPP #-} - {-# LANGUAGE ScopedTypeVariables #-} - module Crypto.Random.Entropy.Unix - ( DevRandom -@@ -22,10 +23,10 @@ import System.Posix.IO - type H = Fd - type DeviceName = String - ---- | Entropy device /dev/random on unix system -+-- | Entropy device /dev/random on unix system - newtype DevRandom = DevRandom DeviceName - ---- | Entropy device /dev/urandom on unix system -+-- | Entropy device /dev/urandom on unix system - newtype DevURandom = DevURandom DeviceName - - instance EntropySource DevRandom where -@@ -48,7 +49,11 @@ testOpen filepath = do - Just h -> closeDev h >> return (Just filepath) - - openDev :: String -> IO (Maybe H) --openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags) -+openDev filepath = (Just `fmap` openFd filepath ReadOnly -+#if !(MIN_VERSION_unix(2,8,0)) -+ Nothing -+#endif -+ fileFlags) - `E.catch` \(_ :: IOException) -> return Nothing - where fileFlags = defaultFileFlags { nonBlock = True } - diff --git a/patches/filelock-0.1.1.3.patch b/patches/filelock-0.1.1.3.patch deleted file mode 100644 index bb991250eb55edc7a6ea741a46016c4018548833..0000000000000000000000000000000000000000 --- a/patches/filelock-0.1.1.3.patch +++ /dev/null @@ -1,31 +0,0 @@ -diff --git a/System/FileLock/Internal/Flock.hsc b/System/FileLock/Internal/Flock.hsc -index 317d755..1ed42ef 100644 ---- a/System/FileLock/Internal/Flock.hsc -+++ b/System/FileLock/Internal/Flock.hsc -@@ -12,7 +12,11 @@ import Data.Bits - import Foreign.C.Error - import Foreign.C.Types - import System.Posix.Files --import System.Posix.IO (openFd, closeFd, defaultFileFlags, OpenMode(..), setFdOption, FdOption(..)) -+import System.Posix.IO ( openFd, closeFd, defaultFileFlags, OpenMode(..), setFdOption, FdOption(..) -+#if MIN_VERSION_unix(2,8,0) -+ , creat -+#endif -+ ) - import System.Posix.Types - import Prelude - -@@ -39,7 +43,12 @@ unlock fd = closeFd fd - - open :: FilePath -> IO Fd - open path = do -- fd <- openFd path WriteOnly (Just stdFileMode) defaultFileFlags -+ fd <- openFd path WriteOnly -+#if MIN_VERSION_unix(2,8,0) -+ (defaultFileFlags {creat = Just stdFileMode}) -+#else -+ (Just stdFileMode) defaultFileFlags -+#endif - -- Ideally, we would open the file descriptor with CLOEXEC enabled, but since - -- unix 2.8 hasn't been released yet and we want backwards compatibility with - -- older releases, we set CLOEXEC after opening the file descriptor. This