Update to work with the new GHC IO library internals

1 files changed, 30 insertions, 0 deletions

diff --git a/System/Posix/IO.hsc b/System/Posix/IO.hsc
index 580b687..25b9598 100644
--- a/System/Posix/IO.hsc
+++ b/System/Posix/IO.hsc
@@ -1,5 +1,6 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -XRecordWildCards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Posix.IO
@@ -73,10 +74,20 @@ import Foreign.C
 import Data.Bits
 
 #ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ >= 611
+import GHC.IO.Handle
+import GHC.IO.Handle.Internals
+import GHC.IO.Handle.Types
+import qualified GHC.IO.FD as FD
+import qualified GHC.IO.Handle.FD as FD
+import GHC.IO.Exception
+import Data.Typeable (cast)
+#else
 import GHC.IOBase
 import GHC.Handle hiding (fdToHandle)
 import qualified GHC.Handle
 #endif
+#endif
 
 #ifdef __HUGS__
 import Hugs.Prelude (IOException(..), IOErrorType(..))
@@ -211,6 +222,24 @@ handleToFd :: Handle -> IO Fd
 fdToHandle :: Fd -> IO Handle
 
 #ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ >= 611
+handleToFd h = withHandle "handleToFd" h $ \ h_@Handle__{haType=_,..} -> do
+  case cast haDevice of
+    Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation
+                                           "handleToFd" (Just h) Nothing) 
+                        "handle is not a file descriptor")
+    Just fd -> do
+     -- converting a Handle into an Fd effectively means
+     -- letting go of the Handle; it is put into a closed
+     -- state as a result. 
+     flushWriteBuffer h_
+     FD.release fd
+     return (Handle__{haType=ClosedHandle,..}, Fd (fromIntegral (FD.fdFD fd)))
+
+fdToHandle fd = FD.fdToHandle (fromIntegral fd)
+
+#else
+
 handleToFd h = withHandle "handleToFd" h $ \ h_ -> do
   -- converting a Handle into an Fd effectively means
   -- letting go of the Handle; it is put into a closed
@@ -225,6 +254,7 @@ handleToFd h = withHandle "handleToFd" h $ \ h_ -> do
 
 fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd)
 #endif
+#endif
 
 #ifdef __HUGS__
 handleToFd h = do