{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.IO.Handle.Windows
-- Copyright   :  (c) The University of Glasgow, 2017
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- Handle operations implemented by Windows native handles
--
-----------------------------------------------------------------------------

module GHC.Internal.IO.Handle.Windows (
  stdin, stdout, stderr,
  openFile, openBinaryFile, openFileBlocking,
  handleToHANDLE, mkHandleFromHANDLE
 ) where

import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable

import GHC.Internal.Base
import GHC.Internal.MVar
import GHC.Internal.IO
import GHC.Internal.IO.BufferedIO hiding (flushWriteBuffer)
import GHC.Internal.IO.Encoding
import GHC.Internal.IO.Device as IODevice
import GHC.Internal.IO.Exception
import GHC.Internal.IO.IOMode
import GHC.Internal.IO.Handle.Types
import GHC.Internal.IO.Handle.Internals
import qualified GHC.Internal.IO.Windows.Handle as Win

-- ---------------------------------------------------------------------------
-- Standard Handles

-- Three handles are allocated during program initialisation.  The first
-- two manage input or output from the Haskell program's standard input
-- or output channel respectively.  The third manages output to the
-- standard error channel. These handles are initially open.

-- | If the std handles are redirected to file handles then WriteConsole etc
--   won't work anymore. When the handle is created test it and if it's a file
--   handle then just convert it to the proper IODevice so WriteFile is used
--   instead. This is done here so it's buffered and only happens once.
mkConsoleHandle :: Win.IoHandle Win.ConsoleHandle
                -> FilePath
                -> HandleType
                -> Bool                     -- buffered?
                -> Maybe TextEncoding
                -> NewlineMode
                -> Maybe HandleFinalizer
                -> Maybe (MVar Handle__)
                -> IO Handle
mkConsoleHandle :: IoHandle ConsoleHandle
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkConsoleHandle IoHandle ConsoleHandle
dev FilePath
filepath HandleType
ha_type Bool
buffered Maybe TextEncoding
mb_codec NewlineMode
nl Maybe HandleFinalizer
finalizer Maybe (MVar Handle__)
other_side
 = do isTerm <- IoHandle ConsoleHandle -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isTerminal IoHandle ConsoleHandle
dev
      case isTerm of
        Bool
True  -> IoHandle ConsoleHandle
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle IoHandle ConsoleHandle
dev FilePath
filepath HandleType
ha_type Bool
buffered Maybe TextEncoding
mb_codec NewlineMode
nl Maybe HandleFinalizer
finalizer
                          Maybe (MVar Handle__)
other_side
        Bool
False -> Io NativeHandle
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle (IoHandle ConsoleHandle -> Bool -> Io NativeHandle
Win.convertHandle IoHandle ConsoleHandle
dev Bool
False) FilePath
filepath HandleType
ha_type Bool
buffered
                            Maybe TextEncoding
mb_codec NewlineMode
nl Maybe HandleFinalizer
finalizer Maybe (MVar Handle__)
other_side

-- | A handle managing input from the Haskell program's standard input channel.
stdin :: Handle
{-# NOINLINE stdin #-}
stdin :: Handle
stdin = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
   enc <- IO TextEncoding
getLocaleEncoding
   mkConsoleHandle Win.stdin "<stdin>" ReadHandle True (Just enc)
                   nativeNewlineMode{-translate newlines-}
                   (Just stdHandleFinalizer) Nothing

-- | A handle managing output to the Haskell program's standard output channel.
stdout :: Handle
{-# NOINLINE stdout #-}
stdout :: Handle
stdout = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
   enc <- IO TextEncoding
getLocaleEncoding
   mkConsoleHandle Win.stdout "<stdout>" WriteHandle True (Just enc)
                   nativeNewlineMode{-translate newlines-}
                   (Just stdHandleFinalizer) Nothing

-- | A handle managing output to the Haskell program's standard error channel.
stderr :: Handle
{-# NOINLINE stderr #-}
stderr :: Handle
stderr = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
   enc <- IO TextEncoding
getLocaleEncoding
   mkConsoleHandle Win.stderr "<stderr>" WriteHandle
                   False{-stderr is unbuffered-} (Just enc)
                   nativeNewlineMode{-translate newlines-}
                  (Just stdHandleFinalizer) Nothing

stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
stdHandleFinalizer :: HandleFinalizer
stdHandleFinalizer FilePath
fp MVar Handle__
m = do
  h_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  flushWriteBuffer h_
  case haType h_ of
      HandleType
ClosedHandle -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HandleType
_other       -> Handle__ -> IO ()
closeTextCodecs Handle__
h_
  putMVar m (ioe_finalizedHandle fp)

-- ---------------------------------------------------------------------------
-- Opening and Closing Files

addFilePathToIOError :: String -> FilePath -> IOException -> IOException
addFilePathToIOError :: FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
fun FilePath
fp IOException
ioe
  = IOException
ioe{ ioe_location = fun, ioe_filename = Just fp }

-- | Computation 'openFile' @file mode@ allocates and returns a new, open
-- handle to manage the file @file@.  It manages input if @mode@
-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
-- and both input and output if mode is 'ReadWriteMode'.
--
-- If the file does not exist and it is opened for output, it should be
-- created as a new file.  If @mode@ is 'WriteMode' and the file
-- already exists, then it should be truncated to zero length.
-- Some operating systems delete empty files, so there is no guarantee
-- that the file will exist following an 'openFile' with @mode@
-- 'WriteMode' unless it is subsequently written to successfully.
-- The handle is positioned at the end of the file if @mode@ is
-- 'AppendMode', and otherwise at the beginning (in which case its
-- internal position is 0).
-- The initial buffer mode is implementation-dependent.
--
-- This operation may fail with:
--
--  * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
--
--  * 'isDoesNotExistError' if the file does not exist; or
--
--  * 'isPermissionError' if the user does not have permission to open the file.
--
-- Note: if you will be working with files containing binary data, you'll want to
-- be using 'openBinaryFile'.
openFile :: FilePath -> IOMode -> IO Handle
openFile :: FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
im =
  IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException
    (FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
True)
    (\IOException
e -> IOException -> IO Handle
forall a. IOException -> IO a
ioError (FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
"openFile" FilePath
fp IOException
e))

-- | Like 'openFile', but opens the file in ordinary blocking mode.
-- This can be useful for opening a FIFO for writing: if we open in
-- non-blocking mode then the open will fail if there are no readers,
-- whereas a blocking open will block until a reader appear.
--
-- @since base-4.4.0.0
openFileBlocking :: FilePath -> IOMode -> IO Handle
openFileBlocking :: FilePath -> IOMode -> IO Handle
openFileBlocking FilePath
fp IOMode
im =
  IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException
    (FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
False)
    (\IOException
e -> IOException -> IO Handle
forall a. IOException -> IO a
ioError (FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
"openFileBlocking" FilePath
fp IOException
e))

-- | Like 'openFile', but open the file in binary mode.
-- On Windows, reading a file in text mode (which is the default)
-- will translate CRLF to LF, and writing will translate LF to CRLF.
-- This is usually what you want with text files.  With binary files
-- this is undesirable; also, as usual under Microsoft operating systems,
-- text mode treats control-Z as EOF.  Binary mode turns off all special
-- treatment of end-of-line and end-of-file characters.
-- (See also 'hSetBinaryMode'.)

openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
m =
  IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException
    (FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
m Bool
True Bool
True)
    (\IOException
e -> IOException -> IO Handle
forall a. IOException -> IO a
ioError (FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
"openBinaryFile" FilePath
fp IOException
e))

openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
openFile' :: FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking = do
  -- first open the file to get a Win32 handle
  (hwnd, hwnd_type) <- FilePath -> IOMode -> Bool -> IO (Io NativeHandle, IODeviceType)
Win.openFile FilePath
filepath IOMode
iomode Bool
non_blocking

  mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding

  -- then use it to make a Handle
  mkHandleFromHANDLE hwnd hwnd_type filepath iomode mb_codec
            `onException` IODevice.close hwnd
        -- NB. don't forget to close the Handle if mkHandleFromHANDLE fails,
        -- otherwise this Handle leaks.

-- ---------------------------------------------------------------------------
-- Converting Windows Handles from/to Handles

mkHandleFromHANDLE
   :: (RawIO dev, IODevice.IODevice dev, BufferedIO dev, Typeable dev) => dev
   -> IODeviceType
   -> FilePath  -- a string describing this Windows handle (e.g. the filename)
   -> IOMode
   -> Maybe TextEncoding
   -> IO Handle

mkHandleFromHANDLE :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> IODeviceType
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> IO Handle
mkHandleFromHANDLE dev
dev IODeviceType
hw_type FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec
  = do
    let nl :: NewlineMode
nl | Maybe TextEncoding -> Bool
forall a. Maybe a -> Bool
isJust Maybe TextEncoding
mb_codec = NewlineMode
nativeNewlineMode
           | Bool
otherwise       = NewlineMode
noNewlineTranslation

    case IODeviceType
hw_type of
        IODeviceType
Directory ->
           IOException -> IO Handle
forall a. HasCallStack => IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InappropriateType FilePath
"openFile"
                           FilePath
"is a directory" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)

        IODeviceType
Stream
           -- only *Streams* can be DuplexHandles.  Other read/write
           -- Handles must share a buffer.
           | IOMode
ReadWriteMode <- IOMode
iomode ->
                dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandle dev
dev FilePath
filepath Maybe TextEncoding
mb_codec NewlineMode
nl


        IODeviceType
_other -> dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandle dev
dev FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec NewlineMode
nl

-- | Turn an existing Handle into a Win32 HANDLE. This function throws an
-- IOError if the Handle does not reference a HANDLE
handleToHANDLE :: Handle -> IO Win.HANDLE
handleToHANDLE :: Handle -> IO HANDLE
handleToHANDLE Handle
h = case Handle
h of
  FileHandle FilePath
_ MVar Handle__
mv -> do
    Handle__{haDevice = dev} <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
readMVar MVar Handle__
mv
    case (cast dev :: Maybe (Win.Io Win.NativeHandle),
          cast dev :: Maybe (Win.Io Win.ConsoleHandle)) of
      (Just Io NativeHandle
hwnd, Maybe (IoHandle ConsoleHandle)
Nothing) -> HANDLE -> IO HANDLE
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HANDLE -> IO HANDLE) -> HANDLE -> IO HANDLE
forall a b. (a -> b) -> a -> b
$ Io NativeHandle -> HANDLE
forall a. RawHandle a => a -> HANDLE
Win.toHANDLE Io NativeHandle
hwnd
      (Maybe (Io NativeHandle)
Nothing, Just IoHandle ConsoleHandle
hwnd) -> HANDLE -> IO HANDLE
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HANDLE -> IO HANDLE) -> HANDLE -> IO HANDLE
forall a b. (a -> b) -> a -> b
$ IoHandle ConsoleHandle -> HANDLE
forall a. RawHandle a => a -> HANDLE
Win.toHANDLE IoHandle ConsoleHandle
hwnd
      (Maybe (Io NativeHandle), Maybe (IoHandle ConsoleHandle))
_                    -> FilePath -> IO HANDLE
forall {a}. FilePath -> IO a
throwErr FilePath
"not a file HANDLE"
  DuplexHandle{} -> FilePath -> IO HANDLE
forall {a}. FilePath -> IO a
throwErr FilePath
"not a file handle"
  where
    throwErr :: FilePath -> IO a
throwErr FilePath
msg = IOException -> IO a
forall a. HasCallStack => IOException -> IO a
ioException (IOException -> IO a) -> IOException -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)
      IOErrorType
InappropriateType FilePath
"handleToHANDLE" FilePath
msg Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing

-- ---------------------------------------------------------------------------
-- Are files opened by default in text or binary mode, if the user doesn't
-- specify? The thing is, to the Win32 APIs which are lowerlevel there exist no
-- such thing as binary/text mode. That's strictly a thing of the C library on
-- top of it.  So I'm not sure what to do with this. -Tamar

dEFAULT_OPEN_IN_BINARY_MODE :: Bool
dEFAULT_OPEN_IN_BINARY_MODE :: Bool
dEFAULT_OPEN_IN_BINARY_MODE = Bool
False