{-# LANGUAGE CPP #-}

module System.EasyFile.Missing where

----------------------------------------------------------------

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 :: FilePath -> IO Bool
isSymlink FilePath
file = FileStatus -> Bool
isSymbolicLink (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
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 :: FilePath -> IO (Maybe Int)
getLinkCount FilePath
file = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (FileStatus -> Int) -> FileStatus -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LinkCount -> Int)
-> (FileStatus -> LinkCount) -> FileStatus -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> LinkCount
linkCount (FileStatus -> Maybe Int) -> IO FileStatus -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
file
#endif

-- |
--   This function returns whether or not a directory has sub-directories.
--   It returns 'Nothing' on Mac and Windows. Since it relies on the link
--   counter, the result is wrong on file systems such as btrfs.
hasSubDirectories :: FilePath -> IO (Maybe Bool)
#ifdef darwin_HOST_OS
hasSubDirectories _ = return Nothing
#else
hasSubDirectories :: FilePath -> IO (Maybe Bool)
hasSubDirectories FilePath
file = (Int -> Bool) -> Maybe Int -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (Maybe Int -> Maybe Bool) -> IO (Maybe Int) -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Int)
getLinkCount FilePath
file
#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 :: FilePath -> IO (Maybe UTCTime)
getCreationTime FilePath
_ = Maybe UTCTime -> IO (Maybe UTCTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
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 :: FilePath -> IO (Maybe UTCTime)
getChangeTime FilePath
file = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime)
-> (FileStatus -> UTCTime) -> FileStatus -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> UTCTime
epochTimeToUTCTime (EpochTime -> UTCTime)
-> (FileStatus -> EpochTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
statusChangeTime (FileStatus -> Maybe UTCTime)
-> IO FileStatus -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
file
#endif

-- |
-- The 'getModificationTime' operation returns the
-- UTC time at which the file or directory was last modified.
-- Unlike the one in "System.Directory", the time is truncated to seconds.
--
-- 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 :: FilePath -> IO UTCTime
getModificationTime FilePath
file = EpochTime -> UTCTime
epochTimeToUTCTime (EpochTime -> UTCTime)
-> (FileStatus -> EpochTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
modificationTime (FileStatus -> UTCTime) -> IO FileStatus -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
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 'getAccessTime' operation returns the
-- UTC time at which the file or directory was last accessed.
-- The time is truncated to seconds.
getAccessTime :: FilePath -> IO UTCTime
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
getAccessTime file = accessTime <$> fileTime file
#else
getAccessTime :: FilePath -> IO UTCTime
getAccessTime FilePath
file = EpochTime -> UTCTime
epochTimeToUTCTime (EpochTime -> UTCTime)
-> (FileStatus -> EpochTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
accessTime (FileStatus -> UTCTime) -> IO FileStatus -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
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 :: EpochTime -> UTCTime
epochTimeToUTCTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (EpochTime -> POSIXTime) -> EpochTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
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 :: FilePath -> IO Word64
getFileSize FilePath
file = FileOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Word64)
-> (FileStatus -> FileOffset) -> FileStatus -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize (FileStatus -> Word64) -> IO FileStatus -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getFileStatus FilePath
file
#endif

-- | Setting the size of the file.
--
--   Since: 0.2.4.
setFileSize :: FilePath -> Word64 -> IO ()
#if (defined(mingw32_HOST_OS) || defined(__MINGW32__))
setFileSize file siz = bracket setup closeHandle $ \hdl -> do
    _ <- setFilePointerEx hdl (fromIntegral siz) fILE_BEGIN
    setEndOfFile hdl
  where
    setup = createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing
                       oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing
#else
setFileSize :: FilePath -> Word64 -> IO ()
setFileSize FilePath
file Word64
siz = FilePath -> FileOffset -> IO ()
P.setFileSize FilePath
file (FileOffset -> IO ()) -> FileOffset -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
siz
#endif