1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
{-# LANGUAGE CPP #-}
module System.EasyFile.Missing where
----------------------------------------------------------------
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Time
import Data.Time.Clock.POSIX
import Data.Word (Word64)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import Control.Exception
import System.Win32.File
import System.Win32.Time
import System.Win32.Types (HANDLE)
#else
import System.Posix.Files as P
import System.Posix.Types
#endif
----------------------------------------------------------------
{-|
This function tells whether or not a file\/directory is symbolic
link.
-}
isSymlink :: FilePath -> IO Bool
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
isSymlink _ = return False
#else
isSymlink file = isSymbolicLink <$> getSymbolicLinkStatus file
#endif
{-|
This function returns the link counter of a file\/directory.
-}
getLinkCount :: FilePath -> IO (Maybe Int)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getLinkCount _ = return Nothing
#else
getLinkCount file = Just . fromIntegral . linkCount <$> getFileStatus file
#endif
{-|
This function returns whether or not a directory has sub-directories.
-}
hasSubDirectories :: FilePath -> IO (Maybe Bool)
#ifdef darwin_HOST_OS
hasSubDirectories _ = return Nothing
#else
hasSubDirectories file = do
Just n <- getLinkCount file
return $ Just (n > 2)
#endif
----------------------------------------------------------------
{-|
The 'getCreationTime' operation returns the
UTC time at which the file or directory was created.
The time is only available on Windows.
-}
getCreationTime :: FilePath -> IO (Maybe UTCTime)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getCreationTime file = Just . creationTime <$> fileTime file
#else
getCreationTime _ = return Nothing
#endif
{-|
The 'getChangeTime' operation returns the
UTC time at which the file or directory was changed.
The time is only available on Unix and Mac.
Note that Unix's rename() does not change ctime but
MacOS's rename() does.
-}
getChangeTime :: FilePath -> IO (Maybe UTCTime)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getChangeTime _ = return Nothing
#else
getChangeTime file = Just . epochTimeToUTCTime . statusChangeTime <$> getFileStatus file
#endif
{-|
The 'getModificationTime' operation returns the
UTC time at which the file or directory was last modified.
The operation may fail with:
* 'isPermissionError' if the user is not permitted to access
the modification time; or
* 'isDoesNotExistError' if the file or directory does not exist.
-}
getModificationTime :: FilePath -> IO UTCTime
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getModificationTime file = writeTime <$> fileTime file
#else
getModificationTime file = epochTimeToUTCTime . modificationTime <$> getFileStatus file
#endif
{-
http://msdn.microsoft.com/en-us/library/ms724290%28VS.85%29.aspx
The NTFS file system delays updates to the last access time for
a file by up to 1 hour after the last access.
-}
{-|
The 'getModificationTime' operation returns the
UTC time at which the file or directory was last accessed.
-}
getAccessTime :: FilePath -> IO UTCTime
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getAccessTime file = accessTime <$> fileTime file
#else
getAccessTime file = epochTimeToUTCTime . accessTime <$> getFileStatus file
#endif
----------------------------------------------------------------
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-- Open a file or directory for getting the file metadata.
withFileForInfo :: FilePath -> (HANDLE -> IO a) -> IO a
withFileForInfo file = bracket setup teardown
where
setup = createFile file 0 fILE_SHARE_READ Nothing
oPEN_EXISTING fILE_FLAG_BACKUP_SEMANTICS Nothing
teardown = closeHandle
#endif
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
creationTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime
creationTime (ctime,_,_) = ctime
accessTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime
accessTime (_,atime,_) = atime
writeTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime
writeTime (_,_,wtime) = wtime
fileTime :: FilePath -> IO (UTCTime,UTCTime,UTCTime)
fileTime file = withFileForInfo file $ \fh -> do
(ctime,atime,mtime) <- getFileTime fh
return (filetimeToUTCTime ctime
,filetimeToUTCTime atime
,filetimeToUTCTime mtime)
{-
http://support.microsoft.com/kb/167296/en-us
100 nano seconds since 1 Jan 1601
MS: _FILETIME = {DWORD,DWORD} = {Word32,Word32}
Haskell: FILETIME == DDWORD == Word64
-}
filetimeToUTCTime :: FILETIME -> UTCTime
filetimeToUTCTime (FILETIME x) = posixSecondsToUTCTime . realToFrac $ tm
where
tm :: Integer
tm = (fromIntegral x - 116444736000000000) `div` 10000000
#else
epochTimeToUTCTime :: EpochTime -> UTCTime
epochTimeToUTCTime = posixSecondsToUTCTime . realToFrac
#endif
-- | Getting the size of the file.
--
-- Since: 0.2.0.
getFileSize :: FilePath -> IO Word64
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getFileSize file = withFileForInfo file $ \fh ->
fromIntegral . bhfiSize <$> getFileInformationByHandle fh
#else
getFileSize file = fromIntegral . fileSize <$> getFileStatus file
#endif
-- | Setting the size of the file.
--
-- Since: 0.2.4.
setFileSize :: FilePath -> Word64 -> IO ()
#if (defined(mingw32_HOST_OS) || defined(__MINGW32__))
# if MIN_VERSION_Win32(2, 6, 2)
setFileSize file siz = do
hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing
_ <- setFilePointerEx hdl (fromIntegral siz) fILE_CURRENT
setEndOfFile hdl
# else
setFileSize _ _ = error "GHC 8.10.5 or earlier does not provide setFilePointerEx"
# endif
#else
setFileSize file siz = P.setFileSize file $ fromIntegral siz
#endif
|
