{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
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
import qualified System.FS.IO.Unix as F
#endif
import qualified System.FS.IO.Handle as H
type HandleIO = F.FHandle
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 {
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