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