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