diff --git a/src/Database/PostgreSQL/Simple/Compat.hs b/src/Database/PostgreSQL/Simple/Compat.hs index 9cae4d5c..3242890e 100644 --- a/src/Database/PostgreSQL/Simple/Compat.hs +++ b/src/Database/PostgreSQL/Simple/Compat.hs @@ -28,46 +28,21 @@ import Data.Text.Lazy.Builder.Scientific (scientificBuilder) import Data.Scientific (scientificBuilder) #endif -#if __GLASGOW_HASKELL__ >= 702 import System.IO.Unsafe (unsafeDupablePerformIO) -#elif __GLASGOW_HASKELL__ >= 611 -import GHC.IO (unsafeDupablePerformIO) -#else -import GHC.IOBase (unsafeDupablePerformIO) -#endif import Data.Fixed (Pico) -#if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(MkFixed)) -#else -import Unsafe.Coerce (unsafeCoerce) -#endif --- | Like 'E.mask', but backported to base before version 4.3.0. --- --- Note that the restore callback is monomorphic, unlike in 'E.mask'. This --- could be fixed by changing the type signature, but it would require us to --- enable the RankNTypes extension (since 'E.mask' has a rank-3 type). The --- 'withTransactionMode' function calls the restore callback only once, so we --- don't need that polymorphism. +-- | Like 'E.mask', but with a monomorphic restore callback, unlike in +-- 'E.mask'. This could be fixed by changing the type signature, but +-- it would require us to enable the RankNTypes extension (since +-- 'E.mask' has a rank-3 type). The 'withTransactionMode' function +-- calls the restore callback only once, so we don't need that +-- polymorphism. mask :: ((IO a -> IO a) -> IO b) -> IO b -#if MIN_VERSION_base(4,3,0) mask io = E.mask $ \restore -> io restore -#else -mask io = do - b <- E.blocked - E.block $ io $ \m -> if b then m else E.unblock m -#endif {-# INLINE mask #-} -#if !MIN_VERSION_base(4,5,0) -infixr 6 <> - -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} -#endif - toByteString :: Builder -> ByteString #if MIN_VERSION_bytestring(0,10,0) toByteString x = toStrict (toLazyByteString x) @@ -75,20 +50,8 @@ toByteString x = toStrict (toLazyByteString x) toByteString x = B.concat (toChunks (toLazyByteString x)) #endif -#if MIN_VERSION_base(4,7,0) - toPico :: Integer -> Pico toPico = MkFixed fromPico :: Pico -> Integer fromPico (MkFixed i) = i - -#else - -toPico :: Integer -> Pico -toPico = unsafeCoerce - -fromPico :: Pico -> Integer -fromPico = unsafeCoerce - -#endif diff --git a/src/Database/PostgreSQL/Simple/Notification.hs b/src/Database/PostgreSQL/Simple/Notification.hs index 5ffda980..894afb5c 100644 --- a/src/Database/PostgreSQL/Simple/Notification.hs +++ b/src/Database/PostgreSQL/Simple/Notification.hs @@ -47,8 +47,6 @@ import GHC.IO.Exception ( ioe_location ) #if defined(mingw32_HOST_OS) import Control.Concurrent ( threadDelay ) -#elif !MIN_VERSION_base(4,7,0) -import Control.Concurrent ( threadWaitRead ) #else import GHC.Conc ( atomically ) import Control.Concurrent ( threadWaitReadSTM ) @@ -94,21 +92,6 @@ getNotification conn = join $ withConnection conn fetch -- with async exceptions, whereas threadDelay can. Just _fd -> do return (threadDelay 1000000 >> loop) -#elif !MIN_VERSION_base(4,7,0) - -- Technically there's a race condition that is usually benign. - -- If the connection is closed or reset after we drop the - -- lock, and then the fd index is reallocated to a new - -- descriptor before we call threadWaitRead, then - -- we could end up waiting on the wrong descriptor. - -- - -- Now, if the descriptor becomes readable promptly, then - -- it's no big deal as we'll wake up and notice the change - -- on the next iteration of the loop. But if are very - -- unlucky, then we could end up waiting a long time. - Just fd -> do - return $ do - threadWaitRead fd `catch` (throwIO . setIOErrorLocation) - loop #else -- This case fixes the race condition above. By registering -- our interest in the descriptor before we drop the lock,