{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
, NoImplicitPrelude
, ExistentialQuantification
, DeriveDataTypeable
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK hide #-}
module GHC.IO.Handle.Types (
Handle(..), Handle__(..), showHandle,
checkHandleInvariants,
BufferList(..),
HandleType(..),
isReadableHandleType, isWritableHandleType, isReadWriteHandleType,
BufferMode(..),
BufferCodec(..),
NewlineMode(..), Newline(..), nativeNewline,
universalNewlineMode, noNewlineTranslation, nativeNewlineMode
) where
#undef DEBUG
import GHC.Base
import GHC.MVar
import GHC.IO
import GHC.IO.Buffer
import GHC.IO.BufferedIO
import GHC.IO.Encoding.Types
import GHC.IORef
import Data.Maybe
import GHC.Show
import GHC.Read
import GHC.Word
import GHC.IO.Device
import Data.Typeable
#ifdef DEBUG
import Control.Monad
#endif
data Handle
= FileHandle
FilePath
!(MVar Handle__)
| DuplexHandle
FilePath
!(MVar Handle__)
!(MVar Handle__)
deriving Typeable
instance Eq Handle where
(FileHandle _ h1) == (FileHandle _ h2) = h1 == h2
(DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2
_ == _ = False
data Handle__
= forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) =>
Handle__ {
haDevice :: !dev,
haType :: HandleType,
haByteBuffer :: !(IORef (Buffer Word8)),
haBufferMode :: BufferMode,
haLastDecode :: !(IORef (dec_state, Buffer Word8)),
haCharBuffer :: !(IORef (Buffer CharBufElem)),
haBuffers :: !(IORef (BufferList CharBufElem)),
haEncoder :: Maybe (TextEncoder enc_state),
haDecoder :: Maybe (TextDecoder dec_state),
haCodec :: Maybe TextEncoding,
haInputNL :: Newline,
haOutputNL :: Newline,
haOtherSide :: Maybe (MVar Handle__)
}
deriving Typeable
data BufferList e
= BufferListNil
| BufferListCons (RawBuffer e) (BufferList e)
data HandleType
= ClosedHandle
| SemiClosedHandle
| ReadHandle
| WriteHandle
| AppendHandle
| ReadWriteHandle
isReadableHandleType :: HandleType -> Bool
isReadableHandleType ReadHandle = True
isReadableHandleType ReadWriteHandle = True
isReadableHandleType _ = False
isWritableHandleType :: HandleType -> Bool
isWritableHandleType AppendHandle = True
isWritableHandleType WriteHandle = True
isWritableHandleType ReadWriteHandle = True
isWritableHandleType _ = False
isReadWriteHandleType :: HandleType -> Bool
isReadWriteHandleType ReadWriteHandle{} = True
isReadWriteHandleType _ = False
checkHandleInvariants :: Handle__ -> IO ()
#ifdef DEBUG
checkHandleInvariants h_ = do
bbuf <- readIORef (haByteBuffer h_)
checkBuffer bbuf
cbuf <- readIORef (haCharBuffer h_)
checkBuffer cbuf
when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $
error ("checkHandleInvariants: char write buffer non-empty: " ++
summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $
error ("checkHandleInvariants: buffer modes differ: " ++
summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
#else
checkHandleInvariants _ = return ()
#endif
data BufferMode
= NoBuffering
| LineBuffering
| BlockBuffering (Maybe Int)
deriving (Eq, Ord, Read, Show)
data Newline = LF
| CRLF
deriving (Eq, Ord, Read, Show)
data NewlineMode
= NewlineMode { inputNL :: Newline,
outputNL :: Newline
}
deriving (Eq, Ord, Read, Show)
nativeNewline :: Newline
#ifdef mingw32_HOST_OS
nativeNewline = CRLF
#else
nativeNewline = LF
#endif
universalNewlineMode :: NewlineMode
universalNewlineMode = NewlineMode { inputNL = CRLF,
outputNL = nativeNewline }
nativeNewlineMode :: NewlineMode
nativeNewlineMode = NewlineMode { inputNL = nativeNewline,
outputNL = nativeNewline }
noNewlineTranslation :: NewlineMode
noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF }
instance Show HandleType where
showsPrec _ t =
case t of
ClosedHandle -> showString "closed"
SemiClosedHandle -> showString "semi-closed"
ReadHandle -> showString "readable"
WriteHandle -> showString "writable"
AppendHandle -> showString "writable (append)"
ReadWriteHandle -> showString "read-writable"
instance Show Handle where
showsPrec _ (FileHandle file _) = showHandle file
showsPrec _ (DuplexHandle file _ _) = showHandle file
showHandle :: FilePath -> String -> String
showHandle file = showString "{handle: " . showString file . showString "}"