{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module System.IO (
    
    IO,
    fixIO,
    
    FilePath,
    Handle,             
    
    
    
    
    
    
    
    
    
    
    
    stdin, stdout, stderr,
    
    
    withFile,
    openFile,
    IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
    
    hClose,
    
    
    readFile,
    writeFile,
    appendFile,
    
    
    
    
    hFileSize,
    hSetFileSize,
    
    hIsEOF,
    isEOF,
    
    BufferMode(NoBuffering,LineBuffering,BlockBuffering),
    hSetBuffering,
    hGetBuffering,
    hFlush,
    
    hGetPosn,
    hSetPosn,
    HandlePosn,                
    hSeek,
    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
    hTell,
    
    hIsOpen, hIsClosed,
    hIsReadable, hIsWritable,
    hIsSeekable,
    
    hIsTerminalDevice,
    hSetEcho,
    hGetEcho,
    
    hShow,
    
    
    hWaitForInput,
    hReady,
    hGetChar,
    hGetLine,
    hLookAhead,
    hGetContents,
    
    hPutChar,
    hPutStr,
    hPutStrLn,
    hPrint,
    
    
    interact,
    putChar,
    putStr,
    putStrLn,
    print,
    getChar,
    getLine,
    getContents,
    readIO,
    readLn,
    
    withBinaryFile,
    openBinaryFile,
    hSetBinaryMode,
    hPutBuf,
    hGetBuf,
    hGetBufSome,
    hPutBufNonBlocking,
    hGetBufNonBlocking,
    
    openTempFile,
    openBinaryTempFile,
    openTempFileWithDefaultPermissions,
    openBinaryTempFileWithDefaultPermissions,
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    hSetEncoding, 
    hGetEncoding,
    
    TextEncoding, 
    latin1,
    utf8, utf8_bom,
    utf16, utf16le, utf16be,
    utf32, utf32le, utf32be, 
    localeEncoding,
    char8,
    mkTextEncoding,
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    hSetNewlineMode, 
    Newline(..), nativeNewline, 
    NewlineMode(..), 
    noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
  ) where
import Control.Exception.Base
import Data.Bits
import Data.List
import Data.Maybe
import Foreign.C.Error
#ifdef mingw32_HOST_OS
import Foreign.C.String
#endif
import Foreign.C.Types
import System.Posix.Internals
import System.Posix.Types
import GHC.Base
import GHC.IO hiding ( bracket, onException )
import GHC.IO.IOMode
import GHC.IO.Handle.FD
import qualified GHC.IO.FD as FD
import GHC.IO.Handle
import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
import GHC.IO.Exception ( userError )
import GHC.IO.Encoding
import GHC.Num
import Text.Read
import GHC.Show
import GHC.MVar
putChar         :: Char -> IO ()
putChar c       =  hPutChar stdout c
putStr          :: String -> IO ()
putStr s        =  hPutStr stdout s
putStrLn        :: String -> IO ()
putStrLn s      =  hPutStrLn stdout s
print           :: Show a => a -> IO ()
print x         =  putStrLn (show x)
getChar         :: IO Char
getChar         =  hGetChar stdin
getLine         :: IO String
getLine         =  hGetLine stdin
getContents     :: IO String
getContents     =  hGetContents stdin
interact        ::  (String -> String) -> IO ()
interact f      =   do s <- getContents
                       putStr (f s)
readFile        :: FilePath -> IO String
readFile name   =  openFile name ReadMode >>= hGetContents
writeFile :: FilePath -> String -> IO ()
writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
appendFile      :: FilePath -> String -> IO ()
appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
readLn          :: Read a => IO a
readLn          =  do l <- getLine
                      r <- readIO l
                      return r
readIO          :: Read a => String -> IO a
readIO s        =  case (do { (x,t) <- reads s ;
                              ("","") <- lex t ;
                              return x }) of
                        [x]    -> return x
                        []     -> ioError (userError "Prelude.readIO: no parse")
                        _      -> ioError (userError "Prelude.readIO: ambiguous parse")
localeEncoding :: TextEncoding
localeEncoding = initLocaleEncoding
hReady          :: Handle -> IO Bool
hReady h        =  hWaitForInput h 0
hPrint          :: Show a => Handle -> a -> IO ()
hPrint hdl      =  hPutStrLn hdl . show
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile name mode = bracket (openFile name mode) hClose
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
fixIO :: (a -> IO a) -> IO a
fixIO k = do
    m <- newEmptyMVar
    ans <- unsafeInterleaveIO (takeMVar m)
    result <- k ans
    putMVar m result
    return result
openTempFile :: FilePath   
             -> String     
                           
                           
             -> IO (FilePath, Handle)
openTempFile tmp_dir template
    = openTempFile' "openTempFile" tmp_dir template False 0o600
openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
openBinaryTempFile tmp_dir template
    = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
openTempFileWithDefaultPermissions :: FilePath -> String
                                   -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions tmp_dir template
    = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666
openBinaryTempFileWithDefaultPermissions :: FilePath -> String
                                         -> IO (FilePath, Handle)
openBinaryTempFileWithDefaultPermissions tmp_dir template
    = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666
openTempFile' :: String -> FilePath -> String -> Bool -> CMode
              -> IO (FilePath, Handle)
openTempFile' loc tmp_dir template binary mode = do
  pid <- c_getpid
  findTempName pid
  where
    
    
    
    (prefix,suffix) =
       case break (== '.') $ reverse template of
         
         (rev_suffix, "")       -> (reverse rev_suffix, "")
         
         
         
         
         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
         
         
         
         _                      -> error "bug in System.IO.openTempFile"
    findTempName x = do
      r <- openNewFile filepath binary mode
      case r of
        FileExists -> findTempName (x + 1)
        OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
        NewFileCreated fd -> do
          (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing
                               False
                               True
          enc <- getLocaleEncoding
          h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False (Just enc)
          return (filepath, h)
      where
        filename        = prefix ++ show x ++ suffix
        filepath        = tmp_dir `combine` filename
        
        combine a b
                  | null b = a
                  | null a = b
                  | last a == pathSeparator = a ++ b
                  | otherwise = a ++ [pathSeparator] ++ b
data OpenNewFileResult
  = NewFileCreated CInt
  | FileExists
  | OpenNewError Errno
openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
openNewFile filepath binary mode = do
  let oflags1 = rw_flags .|. o_EXCL
      binary_flags
        | binary    = o_BINARY
        | otherwise = 0
      oflags = oflags1 .|. binary_flags
  fd <- withFilePath filepath $ \ f ->
          c_open f oflags mode
  if fd < 0
    then do
      errno <- getErrno
      case errno of
        _ | errno == eEXIST -> return FileExists
#ifdef mingw32_HOST_OS
        
        
        
        
        _ | errno == eACCES -> do
          withCString filepath $ \path -> do
            
            
            
            
            exists <- c_fileExists path
            return $ if exists
              then FileExists
              else OpenNewError errno
#endif
        _ -> return (OpenNewError errno)
    else return (NewFileCreated fd)
#ifdef mingw32_HOST_OS
foreign import ccall "file_exists" c_fileExists :: CString -> IO Bool
#endif
pathSeparator :: Char
#ifdef mingw32_HOST_OS
pathSeparator = '\\'
#else
pathSeparator = '/'
#endif
std_flags, output_flags, rw_flags :: CInt
std_flags    = o_NONBLOCK   .|. o_NOCTTY
output_flags = std_flags    .|. o_CREAT
rw_flags     = output_flags .|. o_RDWR