module System.Log.FastLogger.FileIO 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

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 (m :: * -> *) a. Monad m => a -> m a
return FD
stderr

getStdoutFD :: IO FD
getStdoutFD :: IO FD
getStdoutFD = FD -> IO FD
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
    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)