{-# LANGUAGE CPP           #-}
{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}

-- | 'IO' implementation of the 'HasFS' interface.
module System.FS.IO (
    HandleIO
  , ioHasFS
  ) where

import           Control.Concurrent.MVar
import qualified Control.Exception as E
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Primitive (PrimMonad (..))
import qualified Data.ByteString.Unsafe as BS
import           Data.Primitive (withMutableByteArrayContents)
import qualified Data.Set as Set
import qualified Foreign
import           GHC.Stack
import qualified System.Directory as Dir
import           System.FS.API
#if defined(mingw32_HOST_OS)
import qualified System.FS.IO.Windows as F
#else
-- treat every other distribution like it is (Ubuntu) Linux
import qualified System.FS.IO.Unix as F
#endif
import qualified System.FS.IO.Handle as H

{-------------------------------------------------------------------------------
  I/O implementation of HasFS
-------------------------------------------------------------------------------}

-- | File handlers for the IO instance for HasFS
--
-- We store the path the handle points to for better error messages
type HandleIO = F.FHandle

-- | 'IO' implementation of the 'HasFS' interface using the /real/ file system.
--
-- The concrete implementation depends on the OS distribution, but behaviour
-- should be similar across distributions.
ioHasFS :: (MonadIO m, PrimState IO ~ PrimState m) => MountPoint -> HasFS m HandleIO
ioHasFS :: forall (m :: * -> *).
(MonadIO m, PrimState IO ~ PrimState m) =>
MountPoint -> HasFS m HandleIO
ioHasFS MountPoint
mount = HasFS {
      -- TODO(adn) Might be useful to implement this properly by reading all
      -- the stuff available at the 'MountPoint'.
      dumpState :: m String
dumpState = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"<dumpState@IO>"
    , hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle HandleIO)
hOpen = \FsPath
fp OpenMode
openMode -> IO (Handle HandleIO) -> m (Handle HandleIO)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle HandleIO) -> m (Handle HandleIO))
-> IO (Handle HandleIO) -> m (Handle HandleIO)
forall a b. (a -> b) -> a -> b
$ do
        let path :: String
path = FsPath -> String
root FsPath
fp
        Fd
osHandle <- FsPath -> IO Fd -> IO Fd
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$
            String -> OpenMode -> IO Fd
F.open String
path OpenMode
openMode
        MVar (Maybe Fd)
hVar <- Maybe Fd -> IO (MVar (Maybe Fd))
forall a. a -> IO (MVar a)
newMVar (Maybe Fd -> IO (MVar (Maybe Fd)))
-> Maybe Fd -> IO (MVar (Maybe Fd))
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
osHandle
        Handle HandleIO -> IO (Handle HandleIO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle HandleIO -> IO (Handle HandleIO))
-> Handle HandleIO -> IO (Handle HandleIO)
forall a b. (a -> b) -> a -> b
$ HandleIO -> FsPath -> Handle HandleIO
forall h. h -> FsPath -> Handle h
Handle (String -> MVar (Maybe Fd) -> HandleIO
forall osHandle.
String -> MVar (Maybe osHandle) -> HandleOS osHandle
H.HandleOS String
path MVar (Maybe Fd)
hVar) FsPath
fp
    , hClose :: HasCallStack => Handle HandleIO -> m ()
hClose = \(Handle HandleIO
h FsPath
fp) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        HandleIO -> IO ()
F.close HandleIO
h
    , hIsOpen :: HasCallStack => Handle HandleIO -> m Bool
hIsOpen = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> (Handle HandleIO -> IO Bool) -> Handle HandleIO -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleIO -> IO Bool
forall osHandle. HandleOS osHandle -> IO Bool
H.isOpenHandleOS (HandleIO -> IO Bool)
-> (Handle HandleIO -> HandleIO) -> Handle HandleIO -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle HandleIO -> HandleIO
forall h. Handle h -> h
handleRaw
    , hSeek :: HasCallStack => Handle HandleIO -> SeekMode -> Int64 -> m ()
hSeek = \(Handle HandleIO
h FsPath
fp) SeekMode
mode Int64
o -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        HandleIO -> SeekMode -> Int64 -> IO ()
F.seek HandleIO
h SeekMode
mode Int64
o
    , hGetSome :: HasCallStack => Handle HandleIO -> Word64 -> m ByteString
hGetSome = \(Handle HandleIO
h FsPath
fp) Word64
n -> IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteString -> IO ByteString
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        HandleIO -> Word64 -> IO ByteString
F.read HandleIO
h Word64
n
    , hGetSomeAt :: HasCallStack =>
Handle HandleIO -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt = \(Handle HandleIO
h FsPath
fp) Word64
n AbsOffset
o -> IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteString -> IO ByteString
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        HandleIO -> Word64 -> Word64 -> IO ByteString
F.pread HandleIO
h Word64
n (AbsOffset -> Word64
unAbsOffset AbsOffset
o)
    , hTruncate :: HasCallStack => Handle HandleIO -> Word64 -> m ()
hTruncate = \(Handle HandleIO
h FsPath
fp) Word64
sz -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        HandleIO -> Word64 -> IO ()
F.truncate HandleIO
h Word64
sz
    , hGetSize :: HasCallStack => Handle HandleIO -> m Word64
hGetSize = \(Handle HandleIO
h FsPath
fp) -> IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ FsPath -> IO Word64 -> IO Word64
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO Word64 -> IO Word64) -> IO Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$
        HandleIO -> IO Word64
F.getSize HandleIO
h
    , hPutSome :: HasCallStack => Handle HandleIO -> ByteString -> m Word64
hPutSome = \(Handle HandleIO
h FsPath
fp) ByteString
bs -> IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ FsPath -> IO Word64 -> IO Word64
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO Word64 -> IO Word64) -> IO Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> (CStringLen -> IO Word64) -> IO Word64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO Word64) -> IO Word64)
-> (CStringLen -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
            Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> IO Word32 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandleIO -> Ptr Word8 -> Int64 -> IO Word32
F.write HandleIO
h (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
ptr) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    , createDirectory :: HasCallStack => FsPath -> m ()
createDirectory = \FsPath
fp -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
Dir.createDirectory (FsPath -> String
root FsPath
fp)
    , listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory = \FsPath
fp -> IO (Set String) -> m (Set String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set String) -> m (Set String))
-> IO (Set String) -> m (Set String)
forall a b. (a -> b) -> a -> b
$ FsPath -> IO (Set String) -> IO (Set String)
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO (Set String) -> IO (Set String))
-> IO (Set String) -> IO (Set String)
forall a b. (a -> b) -> a -> b
$
        [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> IO [String] -> IO (Set String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  String -> IO [String]
Dir.listDirectory (FsPath -> String
root FsPath
fp)
    , doesDirectoryExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist= \FsPath
fp -> IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FsPath -> IO Bool -> IO Bool
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
        String -> IO Bool
Dir.doesDirectoryExist (FsPath -> String
root FsPath
fp)
    , doesFileExist :: HasCallStack => FsPath -> m Bool
doesFileExist = \FsPath
fp -> IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FsPath -> IO Bool -> IO Bool
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
        String -> IO Bool
Dir.doesFileExist (FsPath -> String
root FsPath
fp)
    , createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectoryIfMissing = \Bool
createParent FsPath
fp -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Bool -> String -> IO ()
Dir.createDirectoryIfMissing Bool
createParent (FsPath -> String
root FsPath
fp)
    , removeDirectoryRecursive :: HasCallStack => FsPath -> m ()
removeDirectoryRecursive = \FsPath
fp -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
Dir.removeDirectoryRecursive (FsPath -> String
root FsPath
fp)
    , removeFile :: HasCallStack => FsPath -> m ()
removeFile = \FsPath
fp -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
Dir.removeFile (FsPath -> String
root FsPath
fp)
    , renameFile :: HasCallStack => FsPath -> FsPath -> m ()
renameFile = \FsPath
fp1 FsPath
fp2 -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FsPath -> IO () -> IO ()
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> String -> IO ()
Dir.renameFile (FsPath -> String
root FsPath
fp1) (FsPath -> String
root FsPath
fp2)
    , mkFsErrorPath :: FsPath -> FsErrorPath
mkFsErrorPath = MountPoint -> FsPath -> FsErrorPath
fsToFsErrorPath MountPoint
mount
    , unsafeToFilePath :: FsPath -> m String
unsafeToFilePath = String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> (FsPath -> String) -> FsPath -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> String
root
    , hGetBufSome :: HasCallStack =>
Handle HandleIO
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufSome = \(Handle HandleIO
h FsPath
fp) MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c ->  IO ByteCount -> m ByteCount
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteCount -> m ByteCount) -> IO ByteCount -> m ByteCount
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteCount -> IO ByteCount
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteCount -> IO ByteCount) -> IO ByteCount -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
        MutableByteArray (PrimState IO)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall (m :: * -> *) a.
PrimBase m =>
MutableByteArray (PrimState m) -> (Ptr Word8 -> m a) -> m a
withMutableByteArrayContents MutableByteArray (PrimState m)
MutableByteArray (PrimState IO)
buf ((Ptr Word8 -> IO ByteCount) -> IO ByteCount)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          HandleIO -> Ptr Word8 -> ByteCount -> IO ByteCount
F.readBuf HandleIO
h (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`Foreign.plusPtr` BufferOffset -> Int
unBufferOffset BufferOffset
bufOff) ByteCount
c
    , hGetBufSomeAt :: HasCallStack =>
Handle HandleIO
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hGetBufSomeAt = \(Handle HandleIO
h FsPath
fp) MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c AbsOffset
off -> IO ByteCount -> m ByteCount
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteCount -> m ByteCount) -> IO ByteCount -> m ByteCount
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteCount -> IO ByteCount
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteCount -> IO ByteCount) -> IO ByteCount -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
        MutableByteArray (PrimState IO)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall (m :: * -> *) a.
PrimBase m =>
MutableByteArray (PrimState m) -> (Ptr Word8 -> m a) -> m a
withMutableByteArrayContents MutableByteArray (PrimState m)
MutableByteArray (PrimState IO)
buf ((Ptr Word8 -> IO ByteCount) -> IO ByteCount)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          HandleIO -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
F.preadBuf HandleIO
h (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`Foreign.plusPtr` BufferOffset -> Int
unBufferOffset BufferOffset
bufOff) ByteCount
c (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> FileOffset) -> Word64 -> FileOffset
forall a b. (a -> b) -> a -> b
$ AbsOffset -> Word64
unAbsOffset AbsOffset
off)
    , hPutBufSome :: HasCallStack =>
Handle HandleIO
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufSome = \(Handle HandleIO
h FsPath
fp) MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c -> IO ByteCount -> m ByteCount
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteCount -> m ByteCount) -> IO ByteCount -> m ByteCount
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteCount -> IO ByteCount
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteCount -> IO ByteCount) -> IO ByteCount -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
        MutableByteArray (PrimState IO)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall (m :: * -> *) a.
PrimBase m =>
MutableByteArray (PrimState m) -> (Ptr Word8 -> m a) -> m a
withMutableByteArrayContents MutableByteArray (PrimState m)
MutableByteArray (PrimState IO)
buf ((Ptr Word8 -> IO ByteCount) -> IO ByteCount)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          HandleIO -> Ptr Word8 -> ByteCount -> IO ByteCount
F.writeBuf HandleIO
h (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`Foreign.plusPtr` BufferOffset -> Int
unBufferOffset BufferOffset
bufOff) ByteCount
c
    , hPutBufSomeAt :: HasCallStack =>
Handle HandleIO
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufSomeAt = \(Handle HandleIO
h FsPath
fp) MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c AbsOffset
off -> IO ByteCount -> m ByteCount
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteCount -> m ByteCount) -> IO ByteCount -> m ByteCount
forall a b. (a -> b) -> a -> b
$ FsPath -> IO ByteCount -> IO ByteCount
forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp (IO ByteCount -> IO ByteCount) -> IO ByteCount -> IO ByteCount
forall a b. (a -> b) -> a -> b
$
        MutableByteArray (PrimState IO)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall (m :: * -> *) a.
PrimBase m =>
MutableByteArray (PrimState m) -> (Ptr Word8 -> m a) -> m a
withMutableByteArrayContents MutableByteArray (PrimState m)
MutableByteArray (PrimState IO)
buf ((Ptr Word8 -> IO ByteCount) -> IO ByteCount)
-> (Ptr Word8 -> IO ByteCount) -> IO ByteCount
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          HandleIO -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
F.pwriteBuf HandleIO
h (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`Foreign.plusPtr` BufferOffset -> Int
unBufferOffset BufferOffset
bufOff) ByteCount
c (Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> FileOffset) -> Word64 -> FileOffset
forall a b. (a -> b) -> a -> b
$ AbsOffset -> Word64
unAbsOffset AbsOffset
off)
    }
  where
    root :: FsPath -> FilePath
    root :: FsPath -> String
root = MountPoint -> FsPath -> String
fsToFilePath MountPoint
mount

    rethrowFsError :: HasCallStack => FsPath -> IO a -> IO a
    rethrowFsError :: forall a. HasCallStack => FsPath -> IO a -> IO a
rethrowFsError FsPath
fp IO a
action = do
        Either IOError a
res <- IO a -> IO (Either IOError a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try IO a
action
        case Either IOError a
res of
          Left IOError
err -> IOError -> IO a
forall a. HasCallStack => IOError -> IO a
handleError IOError
err
          Right a
a  -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      where
        handleError :: HasCallStack => IOError -> IO a
        handleError :: forall a. HasCallStack => IOError -> IO a
handleError IOError
ioErr = FsError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (FsError -> IO a) -> FsError -> IO a
forall a b. (a -> b) -> a -> b
$ HasCallStack => FsErrorPath -> IOError -> FsError
FsErrorPath -> IOError -> FsError
ioToFsError FsErrorPath
errorPath IOError
ioErr

        errorPath :: FsErrorPath
        errorPath :: FsErrorPath
errorPath = MountPoint -> FsPath -> FsErrorPath
fsToFsErrorPath MountPoint
mount FsPath
fp