+ = Handle__ {
+ haFO__ :: FILE_OBJECT,
+ haType__ :: Handle__Type,
+ haBufferMode__ :: BufferMode,
+ haFilePath__ :: String
+ }
+
+{-
+ Internally, we classify handles as being one
+ of the following:
+
+-}
+data Handle__Type
+ = ErrorHandle IOError
+ | ClosedHandle
+ | SemiClosedHandle
+ | ReadHandle
+ | WriteHandle
+ | AppendHandle
+ | ReadWriteHandle
+
+
+-- handle types are 'show'ed when printing error msgs, so
+-- we provide a more user-friendly Show instance for it
+-- than the derived one.
+instance Show Handle__Type where
+ showsPrec p t =
+ case t of
+ ErrorHandle iot -> showString "error " . showsPrec p iot
+ ClosedHandle -> showString "closed"
+ SemiClosedHandle -> showString "semi-closed"
+ ReadHandle -> showString "readable"
+ WriteHandle -> showString "writeable"
+ AppendHandle -> showString "writeable (append)"
+ ReadWriteHandle -> showString "read-writeable"
+
+instance Show Handle where
+ showsPrec p (Handle h) =
+ let
+#if defined(__CONCURRENT_HASKELL__)
+ -- (Big) SIGH: unfolded defn of takeMVar to avoid
+ -- an (oh-so) unfortunate module loop with PrelConc.
+ hdl_ = unsafePerformIO (IO $ \ s# ->
+ case h of { MVar h# ->
+ case takeMVar# h# s# of { StateAndPtr# s2# r ->
+ IOok s2# r }})
+#else
+ hdl_ = unsafePerformIO (stToIO (readVar h))
+#endif
+ in
+ showChar '{' .
+ showHdl (haType__ hdl_)
+ (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
+ showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
+ showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
+ where
+ showHdl :: Handle__Type -> ShowS -> ShowS
+ showHdl ht cont =
+ case ht of
+ ClosedHandle -> showsPrec p ht . showString "}\n"
+ ErrorHandle _ -> showsPrec p ht . showString "}\n"
+ _ -> cont
+
+ showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
+ showBufMode fo bmo =
+ case bmo of
+ NoBuffering -> showString "none"
+ LineBuffering -> showString "line"
+ BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
+ BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
+ where
+ def :: Int
+ def = unsafePerformIO (_ccall_ getBufSize fo)
+
+
+{-
+ nullFile__ is only used for closed handles, plugging it in as
+ a null file object reference.
+-}
+nullFile__ :: FILE_OBJECT
+nullFile__ =