{-# LANGUAGE CPP, TypeSynonymInstances #-}
{-# LANGUAGE Trustworthy #-}
module System.IO.HVFS(
HVFS(..), HVFSStat(..),
HVFSOpenable(..), HVFSOpenEncap(..),HVFSStatEncap(..),
withStat, withOpen,
SystemFS(..),
FilePath, DeviceID, FileID, FileMode, LinkCount,
UserID, GroupID, FileOffset, EpochTime,
IOMode
)
where
import qualified Control.Exception (catch, IOException)
import System.IO.HVIO
import System.Time.Utils
import System.IO
import System.IO.Error
import System.IO.PlafCompat
import System.Posix.Types
import System.Time
import qualified System.Directory as D
#if MIN_VERSION_directory(1,2,0)
import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds )
#endif
data HVFSStatEncap = forall a. HVFSStat a => HVFSStatEncap a
withStat :: forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat :: HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat s :: HVFSStatEncap
s f :: forall a. HVFSStat a => a -> b
f =
case HVFSStatEncap
s of
HVFSStatEncap x :: a
x -> a -> b
forall a. HVFSStat a => a -> b
f a
x
data HVFSOpenEncap = forall a. HVIO a => HVFSOpenEncap a
withOpen :: forall b. HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
withOpen :: HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
withOpen s :: HVFSOpenEncap
s f :: forall a. HVIO a => a -> b
f =
case HVFSOpenEncap
s of
HVFSOpenEncap x :: a
x -> a -> b
forall a. HVIO a => a -> b
f a
x
class (Show a) => HVFSStat a where
vDeviceID :: a -> DeviceID
vFileID :: a -> FileID
vFileMode :: a -> FileMode
vLinkCount :: a -> LinkCount
vFileOwner :: a -> UserID
vFileGroup :: a -> GroupID
vSpecialDeviceID :: a -> DeviceID
vFileSize :: a -> FileOffset
vAccessTime :: a -> EpochTime
vModificationTime :: a -> EpochTime
vStatusChangeTime :: a -> EpochTime
vIsBlockDevice :: a -> Bool
vIsCharacterDevice :: a -> Bool
vIsNamedPipe :: a -> Bool
vIsRegularFile :: a -> Bool
vIsDirectory :: a -> Bool
vIsSymbolicLink :: a -> Bool
vIsSocket :: a -> Bool
vDeviceID _ = 0
vFileID _ = 0
vFileMode x :: a
x = if a -> Bool
forall a. HVFSStat a => a -> Bool
vIsDirectory a
x then 0x755 else 0o0644
vLinkCount _ = 1
vFileOwner _ = 0
vFileGroup _ = 0
vSpecialDeviceID _ = 0
vFileSize _ = 0
vAccessTime _ = 0
vModificationTime _ = 0
vStatusChangeTime _ = 0
vIsBlockDevice _ = Bool
False
vIsCharacterDevice _ = Bool
False
vIsNamedPipe _ = Bool
False
vIsSymbolicLink _ = Bool
False
vIsSocket _ = Bool
False
class (Show a) => HVFS a where
vGetCurrentDirectory :: a -> IO FilePath
vSetCurrentDirectory :: a -> FilePath -> IO ()
vGetDirectoryContents :: a -> FilePath -> IO [FilePath]
vDoesFileExist :: a -> FilePath -> IO Bool
vDoesDirectoryExist :: a -> FilePath -> IO Bool
vDoesExist :: a -> FilePath -> IO Bool
vCreateDirectory :: a -> FilePath -> IO ()
vRemoveDirectory :: a -> FilePath -> IO ()
vRenameDirectory :: a -> FilePath -> FilePath -> IO ()
vRemoveFile :: a -> FilePath -> IO ()
vRenameFile :: a -> FilePath -> FilePath -> IO ()
vGetFileStatus :: a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus :: a -> FilePath -> IO HVFSStatEncap
vGetModificationTime :: a -> FilePath -> IO ClockTime
vRaiseError :: a -> IOErrorType -> String -> Maybe FilePath -> IO c
vCreateSymbolicLink :: a -> FilePath -> FilePath -> IO ()
vReadSymbolicLink :: a -> FilePath -> IO FilePath
vCreateLink :: a -> FilePath -> FilePath -> IO ()
vGetModificationTime fs :: a
fs fp :: FilePath
fp =
do HVFSStatEncap
s <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetFileStatus a
fs FilePath
fp
ClockTime -> IO ClockTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ClockTime -> IO ClockTime) -> ClockTime -> IO ClockTime
forall a b. (a -> b) -> a -> b
$ EpochTime -> ClockTime
forall a. Real a => a -> ClockTime
epochToClockTime (HVFSStatEncap
-> (forall a. HVFSStat a => a -> EpochTime) -> EpochTime
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
s forall a. HVFSStat a => a -> EpochTime
vModificationTime)
vRaiseError _ et :: IOErrorType
et desc :: FilePath
desc mfp :: Maybe FilePath
mfp =
IOError -> IO c
forall a. IOError -> IO a
ioError (IOError -> IO c) -> IOError -> IO c
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
et FilePath
desc Maybe Handle
forall a. Maybe a
Nothing Maybe FilePath
mfp
vGetCurrentDirectory fs :: a
fs = a -> FilePath -> IO FilePath
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vGetCurrentDirectory"
vSetCurrentDirectory fs :: a
fs _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vSetCurrentDirectory"
vGetDirectoryContents fs :: a
fs _ = a -> FilePath -> IO [FilePath]
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vGetDirectoryContents"
vDoesFileExist fs :: a
fs fp :: FilePath
fp =
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch (do HVFSStatEncap
s <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetFileStatus a
fs FilePath
fp
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ HVFSStatEncap -> (forall a. HVFSStat a => a -> Bool) -> Bool
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
s forall a. HVFSStat a => a -> Bool
vIsRegularFile
) (\(IOError
_ :: Control.Exception.IOException) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
vDoesDirectoryExist fs :: a
fs fp :: FilePath
fp =
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch (do HVFSStatEncap
s <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetFileStatus a
fs FilePath
fp
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ HVFSStatEncap -> (forall a. HVFSStat a => a -> Bool) -> Bool
forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat HVFSStatEncap
s forall a. HVFSStat a => a -> Bool
vIsDirectory
) (\(IOError
_ :: Control.Exception.IOException) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
vDoesExist fs :: a
fs fp :: FilePath
fp =
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch (do HVFSStatEncap
s <- a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus a
fs FilePath
fp
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
) (\(IOError
_ :: Control.Exception.IOException) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
vCreateDirectory fs :: a
fs _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vCreateDirectory"
vRemoveDirectory fs :: a
fs _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vRemoveDirectory"
vRemoveFile fs :: a
fs _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vRemoveFile"
vRenameFile fs :: a
fs _ _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vRenameFile"
vRenameDirectory fs :: a
fs _ _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vRenameDirectory"
vCreateSymbolicLink fs :: a
fs _ _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vCreateSymbolicLink"
vReadSymbolicLink fs :: a
fs _ = a -> FilePath -> IO FilePath
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vReadSymbolicLink"
vCreateLink fs :: a
fs _ _ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs "vCreateLink"
vGetSymbolicLinkStatus = a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetFileStatus
eh :: HVFS a => a -> String -> IO c
eh :: a -> FilePath -> IO c
eh fs :: a
fs desc :: FilePath
desc = a -> IOErrorType -> FilePath -> Maybe FilePath -> IO c
forall a c.
HVFS a =>
a -> IOErrorType -> FilePath -> Maybe FilePath -> IO c
vRaiseError a
fs IOErrorType
illegalOperationErrorType
(FilePath
desc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is not implemented in this HVFS class") Maybe FilePath
forall a. Maybe a
Nothing
class HVFS a => HVFSOpenable a where
vOpen :: a -> FilePath -> IOMode -> IO HVFSOpenEncap
vReadFile :: a -> FilePath -> IO String
vWriteFile :: a -> FilePath -> String -> IO ()
vOpenBinaryFile :: a -> FilePath -> IOMode -> IO HVFSOpenEncap
vReadFile h :: a
h fp :: FilePath
fp =
do HVFSOpenEncap
oe <- a -> FilePath -> IOMode -> IO HVFSOpenEncap
forall a.
HVFSOpenable a =>
a -> FilePath -> IOMode -> IO HVFSOpenEncap
vOpen a
h FilePath
fp IOMode
ReadMode
HVFSOpenEncap
-> (forall a. HVIO a => a -> IO FilePath) -> IO FilePath
forall b. HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
withOpen HVFSOpenEncap
oe (\fh :: a
fh -> a -> IO FilePath
forall a. HVIO a => a -> IO FilePath
vGetContents a
fh)
vWriteFile h :: a
h fp :: FilePath
fp s :: FilePath
s =
do HVFSOpenEncap
oe <- a -> FilePath -> IOMode -> IO HVFSOpenEncap
forall a.
HVFSOpenable a =>
a -> FilePath -> IOMode -> IO HVFSOpenEncap
vOpen a
h FilePath
fp IOMode
WriteMode
HVFSOpenEncap -> (forall a. HVIO a => a -> IO ()) -> IO ()
forall b. HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
withOpen HVFSOpenEncap
oe (\fh :: a
fh -> do a -> FilePath -> IO ()
forall a. HVIO a => a -> FilePath -> IO ()
vPutStr a
fh FilePath
s
a -> IO ()
forall a. HVIO a => a -> IO ()
vClose a
fh)
vOpenBinaryFile = a -> FilePath -> IOMode -> IO HVFSOpenEncap
forall a.
HVFSOpenable a =>
a -> FilePath -> IOMode -> IO HVFSOpenEncap
vOpen
instance Show FileStatus where
show :: FileStatus -> FilePath
show _ = "<FileStatus>"
instance HVFSStat FileStatus where
vDeviceID :: FileStatus -> DeviceID
vDeviceID = FileStatus -> DeviceID
deviceID
vFileID :: FileStatus -> FileID
vFileID = FileStatus -> FileID
fileID
vFileMode :: FileStatus -> FileMode
vFileMode = FileStatus -> FileMode
fileMode
vLinkCount :: FileStatus -> LinkCount
vLinkCount = FileStatus -> LinkCount
linkCount
vFileOwner :: FileStatus -> UserID
vFileOwner = FileStatus -> UserID
fileOwner
vFileGroup :: FileStatus -> GroupID
vFileGroup = FileStatus -> GroupID
fileGroup
vSpecialDeviceID :: FileStatus -> DeviceID
vSpecialDeviceID = FileStatus -> DeviceID
specialDeviceID
vFileSize :: FileStatus -> FileOffset
vFileSize = FileStatus -> FileOffset
fileSize
vAccessTime :: FileStatus -> EpochTime
vAccessTime = FileStatus -> EpochTime
accessTime
vModificationTime :: FileStatus -> EpochTime
vModificationTime = FileStatus -> EpochTime
modificationTime
vStatusChangeTime :: FileStatus -> EpochTime
vStatusChangeTime = FileStatus -> EpochTime
statusChangeTime
vIsBlockDevice :: FileStatus -> Bool
vIsBlockDevice = FileStatus -> Bool
isBlockDevice
vIsCharacterDevice :: FileStatus -> Bool
vIsCharacterDevice = FileStatus -> Bool
isCharacterDevice
vIsNamedPipe :: FileStatus -> Bool
vIsNamedPipe = FileStatus -> Bool
isNamedPipe
vIsRegularFile :: FileStatus -> Bool
vIsRegularFile = FileStatus -> Bool
isRegularFile
vIsDirectory :: FileStatus -> Bool
vIsDirectory = FileStatus -> Bool
isDirectory
vIsSymbolicLink :: FileStatus -> Bool
vIsSymbolicLink = FileStatus -> Bool
isSymbolicLink
vIsSocket :: FileStatus -> Bool
vIsSocket = FileStatus -> Bool
isSocket
data SystemFS = SystemFS
deriving (SystemFS -> SystemFS -> Bool
(SystemFS -> SystemFS -> Bool)
-> (SystemFS -> SystemFS -> Bool) -> Eq SystemFS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemFS -> SystemFS -> Bool
$c/= :: SystemFS -> SystemFS -> Bool
== :: SystemFS -> SystemFS -> Bool
$c== :: SystemFS -> SystemFS -> Bool
Eq, Int -> SystemFS -> FilePath -> FilePath
[SystemFS] -> FilePath -> FilePath
SystemFS -> FilePath
(Int -> SystemFS -> FilePath -> FilePath)
-> (SystemFS -> FilePath)
-> ([SystemFS] -> FilePath -> FilePath)
-> Show SystemFS
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SystemFS] -> FilePath -> FilePath
$cshowList :: [SystemFS] -> FilePath -> FilePath
show :: SystemFS -> FilePath
$cshow :: SystemFS -> FilePath
showsPrec :: Int -> SystemFS -> FilePath -> FilePath
$cshowsPrec :: Int -> SystemFS -> FilePath -> FilePath
Show)
instance HVFS SystemFS where
vGetCurrentDirectory :: SystemFS -> IO FilePath
vGetCurrentDirectory _ = IO FilePath
D.getCurrentDirectory
vSetCurrentDirectory :: SystemFS -> FilePath -> IO ()
vSetCurrentDirectory _ = FilePath -> IO ()
D.setCurrentDirectory
vGetDirectoryContents :: SystemFS -> FilePath -> IO [FilePath]
vGetDirectoryContents _ = FilePath -> IO [FilePath]
D.getDirectoryContents
vDoesFileExist :: SystemFS -> FilePath -> IO Bool
vDoesFileExist _ = FilePath -> IO Bool
D.doesFileExist
vDoesDirectoryExist :: SystemFS -> FilePath -> IO Bool
vDoesDirectoryExist _ = FilePath -> IO Bool
D.doesDirectoryExist
vCreateDirectory :: SystemFS -> FilePath -> IO ()
vCreateDirectory _ = FilePath -> IO ()
D.createDirectory
vRemoveDirectory :: SystemFS -> FilePath -> IO ()
vRemoveDirectory _ = FilePath -> IO ()
D.removeDirectory
vRenameDirectory :: SystemFS -> FilePath -> FilePath -> IO ()
vRenameDirectory _ = FilePath -> FilePath -> IO ()
D.renameDirectory
vRemoveFile :: SystemFS -> FilePath -> IO ()
vRemoveFile _ = FilePath -> IO ()
D.removeFile
vRenameFile :: SystemFS -> FilePath -> FilePath -> IO ()
vRenameFile _ = FilePath -> FilePath -> IO ()
D.renameFile
vGetFileStatus :: SystemFS -> FilePath -> IO HVFSStatEncap
vGetFileStatus _ fp :: FilePath
fp = FilePath -> IO FileStatus
getFileStatus FilePath
fp IO FileStatus
-> (FileStatus -> IO HVFSStatEncap) -> IO HVFSStatEncap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HVFSStatEncap -> IO HVFSStatEncap
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap -> IO HVFSStatEncap)
-> (FileStatus -> HVFSStatEncap) -> FileStatus -> IO HVFSStatEncap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> HVFSStatEncap
forall a. HVFSStat a => a -> HVFSStatEncap
HVFSStatEncap
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
vGetSymbolicLinkStatus :: SystemFS -> FilePath -> IO HVFSStatEncap
vGetSymbolicLinkStatus _ fp :: FilePath
fp = FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
fp IO FileStatus
-> (FileStatus -> IO HVFSStatEncap) -> IO HVFSStatEncap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HVFSStatEncap -> IO HVFSStatEncap
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap -> IO HVFSStatEncap)
-> (FileStatus -> HVFSStatEncap) -> FileStatus -> IO HVFSStatEncap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> HVFSStatEncap
forall a. HVFSStat a => a -> HVFSStatEncap
HVFSStatEncap
#else
vGetSymbolicLinkStatus = vGetFileStatus
#endif
#if MIN_VERSION_directory(1,2,0)
vGetModificationTime :: SystemFS -> FilePath -> IO ClockTime
vGetModificationTime _ p :: FilePath
p = FilePath -> IO UTCTime
D.getModificationTime FilePath
p IO UTCTime -> (UTCTime -> IO ClockTime) -> IO ClockTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\modUTCTime :: UTCTime
modUTCTime -> ClockTime -> IO ClockTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ClockTime -> IO ClockTime) -> ClockTime -> IO ClockTime
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> ClockTime
TOD ((Int -> Integer
forall a. Enum a => Int -> a
toEnum (Int -> Integer) -> (UTCTime -> Int) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int
forall a. Enum a => a -> Int
fromEnum (POSIXTime -> Int) -> (UTCTime -> POSIXTime) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds) UTCTime
modUTCTime) 0)
#else
vGetModificationTime _ = D.getModificationTime
#endif
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
vCreateSymbolicLink :: SystemFS -> FilePath -> FilePath -> IO ()
vCreateSymbolicLink _ = FilePath -> FilePath -> IO ()
createSymbolicLink
vReadSymbolicLink :: SystemFS -> FilePath -> IO FilePath
vReadSymbolicLink _ = FilePath -> IO FilePath
readSymbolicLink
vCreateLink :: SystemFS -> FilePath -> FilePath -> IO ()
vCreateLink _ = FilePath -> FilePath -> IO ()
createLink
#else
vCreateSymbolicLink _ _ _ = fail "Symbolic link creation not supported by Windows"
vReadSymbolicLink _ _ = fail "Symbolic link reading not supported by Widnows"
vCreateLink _ _ _ = fail "Hard link creation not supported by Windows"
#endif
instance HVFSOpenable SystemFS where
vOpen :: SystemFS -> FilePath -> IOMode -> IO HVFSOpenEncap
vOpen _ fp :: FilePath
fp iomode :: IOMode
iomode = FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
iomode IO Handle -> (Handle -> IO HVFSOpenEncap) -> IO HVFSOpenEncap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HVFSOpenEncap -> IO HVFSOpenEncap
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSOpenEncap -> IO HVFSOpenEncap)
-> (Handle -> HVFSOpenEncap) -> Handle -> IO HVFSOpenEncap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> HVFSOpenEncap
forall a. HVIO a => a -> HVFSOpenEncap
HVFSOpenEncap
vOpenBinaryFile :: SystemFS -> FilePath -> IOMode -> IO HVFSOpenEncap
vOpenBinaryFile _ fp :: FilePath
fp iomode :: IOMode
iomode = FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
iomode IO Handle -> (Handle -> IO HVFSOpenEncap) -> IO HVFSOpenEncap
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HVFSOpenEncap -> IO HVFSOpenEncap
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSOpenEncap -> IO HVFSOpenEncap)
-> (Handle -> HVFSOpenEncap) -> Handle -> IO HVFSOpenEncap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> HVFSOpenEncap
forall a. HVIO a => a -> HVFSOpenEncap
HVFSOpenEncap