{-# 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 :: 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.
-}
hasSubDirectories :: FilePath -> IO (Maybe Bool)
#ifdef darwin_HOST_OS
hasSubDirectories _ = return Nothing
#else
hasSubDirectories :: FilePath -> IO (Maybe Bool)
hasSubDirectories FilePath
file = do
  Just Int
n <- FilePath -> IO (Maybe Int)
getLinkCount FilePath
file
  Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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 :: 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.

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 '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 :: 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__))
# 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 :: 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