{-# LANGUAGE CPP            #-}
{-# LANGUAGE PackageImports #-}

-- | This module is mainly meant to be used for the 'IO' implementation of
-- 'System.FS.API.HasFS'.
module System.FS.IO.Unix (
    FHandle
  , close
  , getSize
  , open
  , pread
  , preadBuf
  , pwriteBuf
  , read
  , readBuf
  , seek
  , truncate
  , write
  , writeBuf
  ) where

import           Prelude hiding (read, truncate)

import           Control.Monad (void)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as Internal
import           Data.Int (Int64)
import           Data.Word (Word32, Word64, Word8)
import           Foreign (Ptr)
import           System.FS.API.Types (AllowExisting (..), OpenMode (..),
                     SeekMode (..))
import           System.FS.IO.Handle
import qualified System.Posix as Posix
import           System.Posix (ByteCount, Fd (..), FileOffset)
import qualified System.Posix.IO.ByteString.Ext as Posix (fdPreadBuf,
                     fdPwriteBuf)

type FHandle = HandleOS Fd

-- | Some sensible defaults for the 'OpenFileFlags'.
--
-- NOTE: the 'unix' package /already/ exports a smart constructor called
-- @defaultFileFlags@ already, but we define our own to not be depedent by
-- whichever default choice unix's library authors made, and to be able to
-- change our minds later if necessary. In particular, we are interested in the
-- 'append' and 'exclusive' flags, which were largely the reason why we
-- introduced this low-level module.
defaultFileFlags :: Posix.OpenFileFlags
defaultFileFlags :: OpenFileFlags
defaultFileFlags = Posix.OpenFileFlags {
      append :: Bool
Posix.append    = Bool
False
    , exclusive :: Bool
Posix.exclusive = Bool
False
    , noctty :: Bool
Posix.noctty    = Bool
False
    , nonBlock :: Bool
Posix.nonBlock  = Bool
False
    , trunc :: Bool
Posix.trunc     = Bool
False
# if MIN_VERSION_unix(2,8,0)
    , nofollow :: Bool
Posix.nofollow  = Bool
False
    , creat :: Maybe FileMode
Posix.creat     = Maybe FileMode
forall a. Maybe a
Nothing
    , cloexec :: Bool
Posix.cloexec   = Bool
False
    , directory :: Bool
Posix.directory = Bool
False
    , sync :: Bool
Posix.sync      = Bool
False
# endif
    }

-- | Opens a file from disk.
open :: FilePath -> OpenMode -> IO Fd
# if MIN_VERSION_unix(2,8,0)
open :: FilePath -> OpenMode -> IO Fd
open FilePath
fp OpenMode
openMode = FilePath -> OpenMode -> OpenFileFlags -> IO Fd
Posix.openFd FilePath
fp OpenMode
posixOpenMode OpenFileFlags
fileFlags
  where
    (OpenMode
posixOpenMode, OpenFileFlags
fileFlags) = case OpenMode
openMode of
      OpenMode
ReadMode         -> ( OpenMode
Posix.ReadOnly
                          , OpenFileFlags
defaultFileFlags
                          )
      AppendMode    AllowExisting
ex -> ( OpenMode
Posix.WriteOnly
                          , OpenFileFlags
defaultFileFlags { Posix.append = True
                                             , Posix.exclusive = isExcl ex
                                             , Posix.creat = Just Posix.stdFileMode }
                          )
      ReadWriteMode AllowExisting
ex -> ( OpenMode
Posix.ReadWrite
                          , OpenFileFlags
defaultFileFlags { Posix.exclusive = isExcl ex
                                             , Posix.creat = Just Posix.stdFileMode }
                          )
      WriteMode     AllowExisting
ex -> ( OpenMode
Posix.ReadWrite
                          , OpenFileFlags
defaultFileFlags { Posix.exclusive = isExcl ex
                                             , Posix.creat = Just Posix.stdFileMode }
                          )

    isExcl :: AllowExisting -> Bool
isExcl AllowExisting
AllowExisting = Bool
False
    isExcl AllowExisting
MustBeNew     = Bool
True
# else
open fp openMode = Posix.openFd fp posixOpenMode fileMode fileFlags
  where
    (posixOpenMode, fileMode, fileFlags) = case openMode of
      ReadMode         -> ( Posix.ReadOnly
                          , Nothing
                          , defaultFileFlags
                          )
      AppendMode    ex -> ( Posix.WriteOnly
                          , Just Posix.stdFileMode
                          , defaultFileFlags { Posix.append = True
                                             , Posix.exclusive = isExcl ex }
                          )
      ReadWriteMode ex -> ( Posix.ReadWrite
                          , Just Posix.stdFileMode
                          , defaultFileFlags { Posix.exclusive = isExcl ex }
                          )
      WriteMode     ex -> ( Posix.ReadWrite
                          , Just Posix.stdFileMode
                          , defaultFileFlags { Posix.exclusive = isExcl ex }
                          )

    isExcl AllowExisting = False
    isExcl MustBeNew     = True
# endif

-- | Writes the data pointed by the input 'Ptr Word8' into the input 'FHandle'.
write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
write :: FHandle -> Ptr Word8 -> Int64 -> IO Word32
write FHandle
h Ptr Word8
data' Int64
bytes = FilePath -> FHandle -> (Fd -> IO Word32) -> IO Word32
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"write" FHandle
h ((Fd -> IO Word32) -> IO Word32) -> (Fd -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    ByteCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Word32) -> IO ByteCount -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdWriteBuf Fd
fd Ptr Word8
data' (Int64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bytes)

-- | Seek within the file.
--
-- The offset may be negative.
--
-- We don't return the new offset since the behaviour of lseek is rather odd
-- (e.g., the file pointer may not actually be moved until a subsequent write)
seek :: FHandle -> SeekMode -> Int64 -> IO ()
seek :: FHandle -> SeekMode -> Int64 -> IO ()
seek FHandle
h SeekMode
seekMode Int64
offset = FilePath -> FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"seek" FHandle
h ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    IO FileOffset -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FileOffset -> IO ()) -> IO FileOffset -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> SeekMode -> FileOffset -> IO FileOffset
Posix.fdSeek Fd
fd SeekMode
seekMode (Int64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset)

-- | Reads a given number of bytes from the input 'FHandle'.
read :: FHandle -> Word64 -> IO ByteString
read :: FHandle -> Word64 -> IO ByteString
read FHandle
h Word64
bytes = FilePath -> FHandle -> (Fd -> IO ByteString) -> IO ByteString
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"read" FHandle
h ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Int -> (Ptr Word8 -> IO Int) -> IO ByteString
Internal.createUptoN (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Int) -> IO ByteCount -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdReadBuf Fd
fd Ptr Word8
ptr (Word64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes)

readBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
readBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
readBuf FHandle
f Ptr Word8
buf ByteCount
c = FilePath -> FHandle -> (Fd -> IO ByteCount) -> IO ByteCount
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"readBuf" FHandle
f ((Fd -> IO ByteCount) -> IO ByteCount)
-> (Fd -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdReadBuf Fd
fd Ptr Word8
buf ByteCount
c

writeBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
writeBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
writeBuf FHandle
f Ptr Word8
buf ByteCount
c = FilePath -> FHandle -> (Fd -> IO ByteCount) -> IO ByteCount
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"writeBuf" FHandle
f ((Fd -> IO ByteCount) -> IO ByteCount)
-> (Fd -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
Posix.fdWriteBuf Fd
fd Ptr Word8
buf ByteCount
c

pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread FHandle
h Word64
bytes Word64
offset = FilePath -> FHandle -> (Fd -> IO ByteString) -> IO ByteString
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"pread" FHandle
h ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Int -> (Ptr Word8 -> IO Int) -> IO ByteString
Internal.createUptoN (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCount -> Int) -> IO ByteCount -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
Posix.fdPreadBuf Fd
fd Ptr Word8
ptr (Word64 -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset)

-- | @'preadBuf' fh buf c off@ reads @c@ bytes into the buffer @buf@ from the file
-- handle @fh@ at the file offset @off@. This does not move the position of the
-- file handle.
preadBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
preadBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
preadBuf FHandle
h Ptr Word8
buf ByteCount
c FileOffset
off = FilePath -> FHandle -> (Fd -> IO ByteCount) -> IO ByteCount
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"preadBuf" FHandle
h ((Fd -> IO ByteCount) -> IO ByteCount)
-> (Fd -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> Fd -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
Posix.fdPreadBuf Fd
fd Ptr Word8
buf ByteCount
c FileOffset
off

-- | @'pwriteBuf' fh buf c off@ writes @c@ bytes from the data in the buffer
-- @buf@ to the file handle @fh@ at the file offset @off@. This does not move
-- the position of the file handle.
pwriteBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
pwriteBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
pwriteBuf FHandle
h Ptr Word8
buf ByteCount
c FileOffset
off = FilePath -> FHandle -> (Fd -> IO ByteCount) -> IO ByteCount
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"pwriteBuf" FHandle
h ((Fd -> IO ByteCount) -> IO ByteCount)
-> (Fd -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> Fd -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
Posix.fdPwriteBuf Fd
fd Ptr Word8
buf ByteCount
c FileOffset
off

-- | Truncates the file managed by the input 'FHandle' to the input size.
truncate :: FHandle -> Word64 -> IO ()
truncate :: FHandle -> Word64 -> IO ()
truncate FHandle
h Word64
sz = FilePath -> FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"truncate" FHandle
h ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Fd -> FileOffset -> IO ()
Posix.setFdSize Fd
fd (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sz)

-- | Close handle
--
-- This is a no-op when the handle is already closed.
close :: FHandle -> IO ()
close :: FHandle -> IO ()
close FHandle
h = FHandle -> (Fd -> IO ()) -> IO ()
forall osHandle. HandleOS osHandle -> (osHandle -> IO ()) -> IO ()
closeHandleOS FHandle
h Fd -> IO ()
Posix.closeFd

-- | File size of the given file pointer
--
-- NOTE: This is not thread safe (changes made to the file in other threads
-- may affect this thread).
getSize :: FHandle -> IO Word64
getSize :: FHandle -> IO Word64
getSize FHandle
h = FilePath -> FHandle -> (Fd -> IO Word64) -> IO Word64
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
withOpenHandle FilePath
"getSize" FHandle
h ((Fd -> IO Word64) -> IO Word64) -> (Fd -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
     FileOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Word64)
-> (FileStatus -> FileOffset) -> FileStatus -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
Posix.fileSize (FileStatus -> Word64) -> IO FileStatus -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> IO FileStatus
Posix.getFdStatus Fd
fd