{-# LANGUAGE CPP                  #-}
{-# LANGUAGE Safe                 #-}
{-# LANGUAGE TypeSynonymInstances #-}
{- arch-tag: HVFS main file
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.IO.HVFS
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Haskell Virtual FS -- generic support for real or virtual filesystem in Haskell

Copyright (c) 2004-2005 John Goerzen, jgoerzen\@complete.org

The idea of this module is to provide virtualization of filesystem calls.
In addition to the \"real\" system filesystem, you can also provide access
to other, virtual, filesystems using the same set of calls.  Examples of
such virtual filesystems might include a remote FTP server, WebDAV server,
a local Hashtable, a ConfigParser object, or any other data structure
you can represent as a tree of named nodes containing strings.

Each 'HVFS' function takes a 'HVFS' \"handle\" ('HVFS' instance) as its
first parameter.  If you wish to operate on the standard system filesystem,
you can just use 'SystemFS'.

The "MissingH.HVFS.IO.InstanceHelpers" module contains some code to help
you make your own HVFS instances.

The 'HVFSOpenable' class works together with the "System.IO.HVIO" module
to provide a complete virtual filesystem and I\/O model that allows you
to open up virtual filesystem files and act upon them in a manner similar
to standard Handles.
-}

module System.IO.HVFS(-- * Implementation Classes \/ Types
                        HVFS(..), HVFSStat(..),
                        HVFSOpenable(..), HVFSOpenEncap(..),HVFSStatEncap(..),
                        withStat, withOpen,
                        SystemFS(..),
                        -- * Re-exported types from other modules
                        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,
      createLink,
      createSymbolicLink,
      getFileStatus,
      getSymbolicLinkStatus,
      readSymbolicLink,
      accessTime,
      deviceID,
      fileGroup,
      fileID,
      fileMode,
      fileOwner,
      fileSize,
      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

{- | Encapsulate a 'HVFSStat' result.  This is required due to Haskell
typing restrictions.  You can get at it with:

> case encap of
>    HVFSStatEncap x -> -- now use x
-}
data HVFSStatEncap = forall a. HVFSStat a => HVFSStatEncap a

{- | Convenience function for working with stat -- takes a stat result
and a function that uses it, and returns the result.

Here is an example from the HVFS source:

>    vGetModificationTime fs fp =
>       do s <- vGetFileStatus fs fp
>          return $ epochToClockTime (withStat s vModificationTime)

See 'System.Time.Utils.epochToClockTime' for more information.
-}
withStat :: forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
withStat :: 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 -> a -> b
forall a. HVFSStat a => a -> b
f a
x

{- | Similar to 'HVFSStatEncap', but for 'vOpen' result.
-}
data HVFSOpenEncap = forall a. HVIO a => HVFSOpenEncap a

{- | Similar to 'withStat', but for the 'vOpen' result. -}
withOpen :: forall b. HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
withOpen :: 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 -> a -> b
forall a. HVIO a => a -> b
f a
x

{- | Evaluating types of files and information about them.

This corresponds to the System.Posix.Types.FileStatus type, and indeed,
that is one instance of this class.

Inplementators must, at minimum, implement 'vIsDirectory' and
'vIsRegularFile'.

Default implementations of everything else are provided, returning
reasonable values.

A default implementation of this is not currently present on Windows.
-}

class (Show a) => HVFSStat a where
    vDeviceID :: a -> DeviceID
    vFileID :: a -> FileID

    {- | Refers to file permissions, NOT the st_mode field from stat(2) -}
    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 a -> Bool
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

{- | The main HVFS class.

Default implementations of these functions are provided:

 * 'vGetModificationTime' -- implemented in terms of 'vGetFileStatus'

 * 'vRaiseError'

 * 'vDoesFileExist' -- implemented in terms of 'vGetFileStatus'

 * 'vDoesDirectoryExist' -- implemented in terms of 'vGetFileStatus'

 * 'vDoesExist' -- implemented in terms of 'vGetSymbolicLinkStatus'

 * 'vGetSymbolicLinkStatus' -- set to call 'vGetFileStatus'.

Default implementations of all other functions
will generate an isIllegalOperation error, since they are assumed to be
un-implemented.

You should always provide at least a 'vGetFileStatus' call, and almost
certainly several of the others.

Most of these functions correspond to functions in System.Directory or
System.Posix.Files.  Please see detailed documentation on them there.
 -}
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
    {- | True if the file exists, regardless of what type it is.
       This is even True if the given path is a broken symlink. -}
    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
    {- | Raise an error relating to actions on this class. -}
    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 <- 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 a
_ IOErrorType
et FilePath
desc 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 a
fs = a -> FilePath -> IO FilePath
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vGetCurrentDirectory"
    vSetCurrentDirectory a
fs FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vSetCurrentDirectory"
    vGetDirectoryContents a
fs FilePath
_ = a -> FilePath -> IO [FilePath]
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vGetDirectoryContents"
    vDoesFileExist a
fs 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 a
fs 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 a
fs 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
_ <- 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 a
fs FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vCreateDirectory"
    vRemoveDirectory a
fs FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vRemoveDirectory"
    vRemoveFile a
fs FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vRemoveFile"
    vRenameFile a
fs FilePath
_ FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vRenameFile"
    vRenameDirectory a
fs FilePath
_ FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vRenameDirectory"
    vCreateSymbolicLink a
fs FilePath
_ FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vCreateSymbolicLink"
    vReadSymbolicLink a
fs FilePath
_ = a -> FilePath -> IO FilePath
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vReadSymbolicLink"
    vCreateLink a
fs FilePath
_ FilePath
_ = a -> FilePath -> IO ()
forall a c. HVFS a => a -> FilePath -> IO c
eh a
fs FilePath
"vCreateLink"
    vGetSymbolicLinkStatus = a -> FilePath -> IO HVFSStatEncap
forall a. HVFS a => a -> FilePath -> IO HVFSStatEncap
vGetFileStatus

-- | Error handler helper
eh :: HVFS a => a -> String -> IO c
eh :: a -> FilePath -> IO c
eh a
fs 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]
++ FilePath
" is not implemented in this HVFS class") Maybe FilePath
forall a. Maybe a
Nothing

{- | Types that can open a HVIO object should be instances of this class.
You need only implement 'vOpen'. -}

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 <- 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 (\a
fh -> a -> IO FilePath
forall a. HVIO a => a -> IO FilePath
vGetContents a
fh)

    vWriteFile a
h FilePath
fp 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 (\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)

    -- | Open a file in binary mode.
    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
_ = FilePath
"<FileStatus>"

----------------------------------------------------------------------
-- Standard implementations
----------------------------------------------------------------------
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 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 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 SystemFS
_ 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
    -- No symlinks on Windows; just get the file status directly
    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 IO UTCTime -> (UTCTime -> IO ClockTime) -> IO ClockTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\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) 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 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 SystemFS
_ FilePath
fp 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