From 3b7854b611293af35a1d69dbc9761b973462d8b3 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 8 Jul 2005 17:17:31 +0000
Subject: [PATCH] [project @ 2005-07-08 17:17:31 by sof] -
 System.Posix.Internals.FDType.RawDevice: new constructor. -
 System.Posix.Internals.fdType: map block devices to
 RawDevice   (but left character devices as still being
 Streams). - GHC.IOBase.isReadWriteHandleType: new
 HandleType predicate. - GHC.Handle.hIsSeekable: RawDevices
 are seekable. - GHC.Handle.openFd: handle RawDevices.    =>
 opening of block devices via std IO opening actions      
 (open{Binary}File, openFd etc.) should now work better.

Merge to STABLE.
---
 GHC/Handle.hs             |   20 ++++++++++++--------
 GHC/IOBase.lhs            |    5 ++++-
 System/Posix/Internals.hs |    4 +++-
 3 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index a3cf25b..0e9b3be 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -915,10 +915,6 @@ openFd fd mb_fd_type is_socket filepath mode binary = do
 	   ioException (IOError Nothing InappropriateType "openFile"
 			   "is a directory" Nothing) 
 
-	Stream
-	   | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary
-	   | otherwise                  -> mkFileHandle fd is_socket filepath ha_type binary
-
 	-- regular files need to be locked
 	RegularFile -> do
 #ifndef mingw32_HOST_OS
@@ -928,7 +924,16 @@ openFd fd mb_fd_type is_socket filepath mode binary = do
 				   "file is locked" Nothing)
 #endif
 	   mkFileHandle fd is_socket filepath ha_type binary
-
+	 -- Stream or RawDevice
+	Stream    -> mkIt ha_type
+	RawDevice -> mkIt ha_type
+	_ ->
+	  ioException (IOError Nothing UnsupportedOperation "openFd"
+			           "unknown file type" Nothing) 
+     where
+      mkIt ht
+       | isReadWriteHandleType ht = mkDuplexHandle fd is_socket filepath binary
+       | otherwise                = mkFileHandle   fd is_socket filepath ht binary
 
 fdToHandle :: FD -> IO Handle
 fdToHandle fd = do
@@ -1462,9 +1467,8 @@ hIsSeekable handle =
       SemiClosedHandle 	   -> ioe_closedHandle
       AppendHandle 	   -> return False
       _                    -> do t <- fdType (haFD handle_)
-                                 return (t == RegularFile
-                                         && (haIsBin handle_ 
-						|| tEXT_MODE_SEEK_ALLOWED))
+                                 return ((t == RegularFile    || t == RawDevice)
+                                         && (haIsBin handle_  || tEXT_MODE_SEEK_ALLOWED))
 
 -- -----------------------------------------------------------------------------
 -- Changing echo status (Non-standard GHC extensions)
diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 0a3cfca..f0ce8de 100644
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -30,7 +30,7 @@ module GHC.IOBase(
     	-- Handles, file descriptors,
     FilePath,  
     Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, 
-    isReadableHandleType, isWritableHandleType, showHandle,
+    isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,
   
     	-- Buffers
     Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
@@ -423,6 +423,9 @@ isWritableHandleType WriteHandle     = True
 isWritableHandleType ReadWriteHandle = True
 isWritableHandleType _	       	     = False
 
+isReadWriteHandleType ReadWriteHandle{} = True
+isReadWriteHandleType _                 = False
+
 -- | File and directory names are values of type 'String', whose precise
 -- meaning is operating system dependent. Files can be opened, yielding a
 -- handle which can then be used to operate on the contents of that file.
diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 7e3ba58..a840e55 100644
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -85,7 +85,7 @@ fdFileSize fd =
     c_size <- st_size p_stat :: IO COff
     return (fromIntegral c_size)
 
-data FDType  = Directory | Stream | RegularFile
+data FDType  = Directory | Stream | RegularFile | RawDevice
 	       deriving (Eq)
 
 fileType :: FilePath -> IO FDType
@@ -112,6 +112,8 @@ statGetType p_stat = do
         | s_isfifo c_mode || s_issock c_mode || s_ischr  c_mode
 			  	-> return Stream
 	| s_isreg c_mode	-> return RegularFile
+	 -- Q: map char devices to RawDevice too?
+	| s_isblk c_mode        -> return RawDevice
 	| otherwise		-> ioError ioe_unknownfiletype
     
 
-- 
1.7.10.4