module System.IO.ExplicitIOModes
(
SIO.IO
, SIO.fixIO
, SIO.FilePath
, Handle
, regularHandle
, R, W, A, RW
, stdin
, stdout
, stderr
, cast
, withFile
, openFile
, IOMode(..)
, hClose
, SIO.readFile
, SIO.writeFile
, SIO.appendFile
, hFileSize
#ifdef __GLASGOW_HASKELL__
, hSetFileSize
#endif
, hIsEOF
, SIO.BufferMode( SIO.NoBuffering, SIO.LineBuffering, SIO.BlockBuffering )
, hSetBuffering
, hGetBuffering
, hFlush
, hGetPosn
, SIO.hSetPosn
, SIO.HandlePosn
, hSeek
, SIO.SeekMode( SIO.AbsoluteSeek, SIO.RelativeSeek, SIO.SeekFromEnd )
#if !defined(__NHC__)
, hTell
#endif
, hIsOpen, hIsClosed
, hIsReadable, hIsWritable
, hIsSeekable
#if !defined(__NHC__)
, hIsTerminalDevice
, hSetEcho
, hGetEcho
#endif
#ifdef __GLASGOW_HASKELL__
, hShow
#endif
, hWaitForInput
, hReady
, hGetChar
, hGetLine
, hLookAhead
, hGetContents
, hPutChar
, hPutStr
, hPutStrLn
, hPrint
, SIO.interact
, SIO.putChar
, SIO.putStr
, SIO.putStrLn
, SIO.print
, SIO.getChar
, SIO.getLine
, SIO.getContents
, SIO.readIO
, SIO.readLn
, withBinaryFile
, openBinaryFile
, hSetBinaryMode
, hPutBuf
, hGetBuf
#if !defined(__NHC__) && !defined(__HUGS__)
, hPutBufNonBlocking
, hGetBufNonBlocking
#endif
, openTempFile
, openBinaryTempFile
) where
import Control.Monad ( liftM, liftM2 )
import Control.Arrow ( second )
import Foreign.Ptr ( Ptr )
import Data.Typeable ( Typeable )
import Data.Tagged ( Tagged(Tagged), unTagged )
import qualified System.IO as SIO
newtype Handle ioMode = Handle
{
regularHandle :: SIO.Handle
}
deriving ( Show, Eq, Typeable )
wrap :: (SIO.Handle -> a) -> (Handle ioMode -> a)
wrap f = f . regularHandle
data R
data W
data A
data RW
class ReadModes ioMode
class WriteModes ioMode
instance ReadModes R
instance ReadModes RW
instance WriteModes W
instance WriteModes A
instance WriteModes RW
stdin :: Handle R
stdin = Handle SIO.stdin
stdout :: Handle W
stdout = Handle SIO.stdout
stderr :: Handle W
stderr = Handle SIO.stderr
cast :: forall anyIOMode castedIOMode. CheckMode castedIOMode
=> Handle anyIOMode -> IO (Maybe (Handle castedIOMode))
cast (Handle h) = do
b <- unTagged (checkMode :: Tagged castedIOMode (SIO.Handle -> IO Bool)) h
return $ if b
then Just $ Handle h
else Nothing
class CheckMode ioMode where
checkMode :: Tagged ioMode (SIO.Handle -> IO Bool)
instance CheckMode R where
checkMode = Tagged SIO.hIsReadable
instance CheckMode W where
checkMode = Tagged SIO.hIsWritable
instance CheckMode A where
checkMode = Tagged SIO.hIsWritable
instance CheckMode RW where
checkMode = Tagged $ \h -> liftM2 (&&) (SIO.hIsReadable h)
(SIO.hIsWritable h)
withFile :: FilePath -> IOMode ioMode -> (Handle ioMode -> IO r) -> IO r
withFile fp ioMode f = SIO.withFile fp (convert ioMode) $ f . Handle
openFile :: FilePath -> IOMode ioMode -> IO (Handle ioMode)
openFile fp = liftM Handle . SIO.openFile fp . convert
data IOMode ioMode where
ReadMode :: IOMode R
WriteMode :: IOMode W
AppendMode :: IOMode A
ReadWriteMode :: IOMode RW
convert :: IOMode ioMode -> SIO.IOMode
convert ReadMode = SIO.ReadMode
convert WriteMode = SIO.WriteMode
convert AppendMode = SIO.AppendMode
convert ReadWriteMode = SIO.ReadWriteMode
instance Eq (IOMode ioMode) where
ReadMode == ReadMode = True
WriteMode == WriteMode = True
AppendMode == AppendMode = True
ReadWriteMode == ReadWriteMode = True
_ == _ = False
instance Ord (IOMode ioMode) where
ReadWriteMode <= ReadWriteMode = True
ReadWriteMode <= _ = False
AppendMode <= ReadWriteMode = True
AppendMode <= AppendMode = True
AppendMode <= _ = False
WriteMode <= ReadWriteMode = True
WriteMode <= AppendMode = True
WriteMode <= WriteMode = True
WriteMode <= _ = False
ReadMode <= ReadWriteMode = True
ReadMode <= AppendMode = True
ReadMode <= WriteMode = True
ReadMode <= ReadMode = True
instance Show (IOMode ioMode) where
show ReadMode = "ReadMode"
show WriteMode = "WriteMode"
show AppendMode = "AppendMode"
show ReadWriteMode = "ReadWriteMode"
hClose :: Handle ioMode -> IO ()
hClose = wrap SIO.hClose
hFileSize :: Handle ioMode -> IO Integer
hFileSize = wrap SIO.hFileSize
#ifdef __GLASGOW_HASKELL__
hSetFileSize :: Handle ioMode -> Integer -> IO ()
hSetFileSize = wrap SIO.hSetFileSize
#endif
hIsEOF :: ReadModes ioMode => Handle ioMode -> IO Bool
hIsEOF = wrap SIO.hIsEOF
hSetBuffering :: Handle ioMode -> SIO.BufferMode -> IO ()
hSetBuffering = wrap SIO.hSetBuffering
hGetBuffering :: Handle ioMode -> IO SIO.BufferMode
hGetBuffering = wrap SIO.hGetBuffering
hFlush :: Handle ioMode -> IO ()
hFlush = wrap SIO.hFlush
hGetPosn :: Handle ioMode -> IO SIO.HandlePosn
hGetPosn = wrap SIO.hGetPosn
hSeek :: Handle ioMode -> SIO.SeekMode -> Integer -> IO ()
hSeek = wrap SIO.hSeek
#if !defined(__NHC__)
hTell :: Handle ioMode -> IO Integer
hTell = wrap SIO.hTell
#endif
hIsOpen :: Handle ioMode -> IO Bool
hIsOpen = wrap SIO.hIsOpen
hIsClosed :: Handle ioMode -> IO Bool
hIsClosed = wrap SIO.hIsClosed
hIsReadable :: Handle ioMode -> IO Bool
hIsReadable = wrap SIO.hIsReadable
hIsWritable :: Handle ioMode -> IO Bool
hIsWritable = wrap SIO.hIsWritable
hIsSeekable :: Handle ioMode -> IO Bool
hIsSeekable = wrap SIO.hIsSeekable
#if !defined(__NHC__)
hIsTerminalDevice :: Handle ioMode -> IO Bool
hIsTerminalDevice = wrap SIO.hIsTerminalDevice
hSetEcho :: Handle ioMode -> Bool -> IO ()
hSetEcho = wrap SIO.hSetEcho
hGetEcho :: Handle ioMode -> IO Bool
hGetEcho = wrap SIO.hGetEcho
#endif
#ifdef __GLASGOW_HASKELL__
hShow :: Handle ioMode -> IO String
hShow = wrap SIO.hShow
#endif
hWaitForInput :: ReadModes ioMode => Handle ioMode -> Int -> IO Bool
hWaitForInput = wrap SIO.hWaitForInput
hReady :: ReadModes ioMode => Handle ioMode -> IO Bool
hReady = wrap SIO.hReady
hGetChar :: ReadModes ioMode => Handle ioMode -> IO Char
hGetChar = wrap SIO.hGetChar
hGetLine :: ReadModes ioMode => Handle ioMode -> IO String
hGetLine = wrap SIO.hGetLine
hLookAhead :: ReadModes ioMode => Handle ioMode -> IO Char
hLookAhead = wrap SIO.hLookAhead
hGetContents :: ReadModes ioMode => Handle ioMode -> IO String
hGetContents = wrap SIO.hGetContents
hPutChar :: WriteModes ioMode => Handle ioMode -> Char -> IO ()
hPutChar = wrap SIO.hPutChar
hPutStr :: WriteModes ioMode => Handle ioMode -> String -> IO ()
hPutStr = wrap SIO.hPutStr
hPutStrLn :: WriteModes ioMode => Handle ioMode -> String -> IO ()
hPutStrLn = wrap SIO.hPutStrLn
hPrint :: (WriteModes ioMode, Show a) => Handle ioMode -> a -> IO ()
hPrint = wrap SIO.hPrint
withBinaryFile :: FilePath -> IOMode ioMode -> (Handle ioMode -> IO r) -> IO r
withBinaryFile fp ioMode f = SIO.withBinaryFile fp (convert ioMode) $ f . Handle
openBinaryFile :: FilePath -> IOMode ioMode -> IO (Handle ioMode)
openBinaryFile fp = liftM Handle . SIO.openBinaryFile fp . convert
hSetBinaryMode :: Handle ioMode -> Bool -> IO ()
hSetBinaryMode = wrap SIO.hSetBinaryMode
hPutBuf :: WriteModes ioMode => Handle ioMode -> Ptr a -> Int -> IO ()
hPutBuf = wrap SIO.hPutBuf
hGetBuf :: ReadModes ioMode => Handle ioMode -> Ptr a -> Int -> IO Int
hGetBuf = wrap SIO.hGetBuf
#if !defined(__NHC__) && !defined(__HUGS__)
hPutBufNonBlocking :: WriteModes ioMode => Handle ioMode -> Ptr a -> Int -> IO Int
hPutBufNonBlocking = wrap SIO.hPutBufNonBlocking
hGetBufNonBlocking :: ReadModes ioMode => Handle ioMode -> Ptr a -> Int -> IO Int
hGetBufNonBlocking = wrap SIO.hGetBufNonBlocking
#endif
openTempFile :: FilePath -> String -> IO (FilePath, Handle RW)
openTempFile fp template = liftM (second Handle) $ SIO.openTempFile fp template
openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle RW)
openBinaryTempFile fp template = liftM (second Handle) $ SIO.openBinaryTempFile fp template