{-# LANGUAGE CPP #-}

-- | Where the bytes actually go.
--
-- The rest of fast-logger fills its own buffer and hands it here as a raw
-- pointer, so this is deliberately one layer below 'Handle': the point of
-- 'writeRawBufferPtr2FD' is that nothing buffers the bytes a second time.
--
-- Windows has two I\/O subsystems and chooses between them at run time, from
-- the @--io-manager=@ RTS flag, so on Windows an 'FD' is one of two things.
-- See the note on 'openFileFD'.
module System.Log.FastLogger.FileIO (
    FD,
    closeFD,
    openFileFD,
    getStderrFD,
    getStdoutFD,
    writeRawBufferPtr2FD,
    invalidFD,
    isFDValid,
) where

import Foreign.Ptr (Ptr)
import GHC.IO.Device (close)
import GHC.IO.FD (openFile, stderr, stdout, writeRawBufferPtr)
import qualified GHC.IO.FD as POSIX (FD (..))
import GHC.IO.IOMode (IOMode (..))

import System.Log.FastLogger.Imports

#if defined(mingw32_HOST_OS)
import GHC.IO.SubSystem (isWindowsNativeIO)
import qualified System.IO as SIO
#endif

#if defined(mingw32_HOST_OS)

-- | A file descriptor, or on Windows under the native I\/O manager a
--   'SIO.Handle' standing in for one.
data FD
    = PosixFD !POSIX.FD
    | -- | Under the native I\/O manager.  The 'SIO.Handle' is left with
      -- whatever buffering it came with and flushed after every write, so
      -- the bytes are no more buffered than they were before.
      NativeFD !SIO.Handle
    | InvalidFD

-- | Opening a log file for appending.
--
-- Under the POSIX subsystem this is a file descriptor, as it always was.
--
-- Under the native subsystem it cannot be.  There a 'POSIX.FD' is a C
-- runtime descriptor, and the I\/O manager works in terms of Windows
-- handles registered with a completion port; the two cannot be mixed, and
-- @base@ says so by replacing every method of @IODevice FD@ and @RawIO FD@
-- with an @error@ when that subsystem is in force.  Opening and the raw
-- write happen to be plain functions and so still work, which is the trap:
-- a log file could be written and never closed, and it stayed locked for
-- the life of the process.
--
-- 'SIO.openFile' gives a handle the running subsystem owns, whichever it
-- is.  Appending is its business too, which matters because the native
-- subsystem writes at an offset given per call and has no @O_APPEND@ of
-- its own.
openFileFD :: FilePath -> IO FD
openFileFD f
    | isWindowsNativeIO = NativeFD <$> SIO.openFile f SIO.AppendMode
    | otherwise = PosixFD . fst <$> openFile f AppendMode False

-- | The standard streams are handed to us, not opened by us, and under the
--   native subsystem the descriptor numbered 1 is not what the process is
--   actually writing through: bytes put there were accepted and never
--   appeared.
getStdoutFD :: IO FD
getStdoutFD
    | isWindowsNativeIO = return $ NativeFD SIO.stdout
    | otherwise = return $ PosixFD stdout

getStderrFD :: IO FD
getStderrFD
    | isWindowsNativeIO = return $ NativeFD SIO.stderr
    | otherwise = return $ PosixFD stderr

-- | Only ever called for a log file, never for a standard stream.
closeFD :: FD -> IO ()
closeFD (PosixFD fd) = close fd
closeFD (NativeFD h) = SIO.hClose h
closeFD InvalidFD = return ()

writeRawBufferPtr2FD :: IORef FD -> Ptr Word8 -> Int -> IO Int
writeRawBufferPtr2FD fdref bf len = do
    fd <- readIORef fdref
    case fd of
        PosixFD fd'
            | POSIX.fdFD fd' /= -1 ->
                fromIntegral <$> writeRawBufferPtr "write" fd' bf 0 (fromIntegral len)
        -- 'SIO.hPutBuf' writes all of it or raises; there is no short write
        -- to report back.
        NativeFD h -> do
            SIO.hPutBuf h bf len
            SIO.hFlush h
            return len
        _ -> return (-1)

invalidFD :: FD
invalidFD = InvalidFD

isFDValid :: FD -> Bool
isFDValid (PosixFD fd) = POSIX.fdFD fd /= -1
isFDValid (NativeFD _) = True
isFDValid InvalidFD = False

#else

type FD = POSIX.FD

closeFD :: FD -> IO ()
closeFD :: FD -> IO ()
closeFD = FD -> IO ()
forall a. IODevice a => a -> IO ()
close

openFileFD :: FilePath -> IO FD
openFileFD :: FilePath -> IO FD
openFileFD FilePath
f = (FD, IODeviceType) -> FD
forall a b. (a, b) -> a
fst ((FD, IODeviceType) -> FD) -> IO (FD, IODeviceType) -> IO FD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IOMode -> Bool -> IO (FD, IODeviceType)
openFile FilePath
f IOMode
AppendMode Bool
False

getStderrFD :: IO FD
getStderrFD :: IO FD
getStderrFD = FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
stderr

getStdoutFD :: IO FD
getStdoutFD :: IO FD
getStdoutFD = FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
stdout

writeRawBufferPtr2FD :: IORef FD -> Ptr Word8 -> Int -> IO Int
writeRawBufferPtr2FD :: IORef FD -> Ptr Word8 -> Int -> IO Int
writeRawBufferPtr2FD IORef FD
fdref Ptr Word8
bf Int
len = do
    FD
fd <- IORef FD -> IO FD
forall a. IORef a -> IO a
readIORef IORef FD
fdref
    if FD -> Bool
isFDValid FD
fd
        then
            CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
writeRawBufferPtr FilePath
"write" FD
fd Ptr Word8
bf Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        else
            Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)

invalidFD :: POSIX.FD
invalidFD :: FD
invalidFD = FD
stdout{POSIX.fdFD = -1}

isFDValid :: POSIX.FD -> Bool
isFDValid :: FD -> Bool
isFDValid FD
fd = FD -> CInt
POSIX.fdFD FD
fd CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= -CInt
1

#endif