-- |
-- Module:     System.Directory.OsPath.FileType
-- Copyright:  (c) Sergey Vinokurov 2024
-- License:    Apache-2.0 (see LICENSE)
-- Maintainer: serg.foo@gmail.com

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ScopedTypeVariables #-}

module System.Directory.OsPath.FileType
  ( getFileType

  , regularFile
  , regularDirectory
  , regularOther
  , symlinkFile
  , symlinkDirectory
  , symlinkOther
  ) where

import System.OsPath.Types (OsPath)
import System.Directory.OsPath.Types

#ifdef mingw32_HOST_OS
import System.Directory.OsPath (doesFileExist, doesDirectoryExist)
#endif
#ifndef mingw32_HOST_OS
import Control.Exception (try, IOException)
import System.OsString.Internal.Types (getOsString)
import qualified System.Posix.Files.PosixString as PosixF
#endif

getFileType :: OsPath -> IO FileType
#ifdef mingw32_HOST_OS
getFileType fp = do
  isFile <- doesFileExist fp
  if isFile
  then pure regularFile
  else do
    isDir <- doesDirectoryExist fp
    pure $ if isDir then regularDirectory else regularOther
#endif
#ifndef mingw32_HOST_OS
getFileType :: OsPath -> IO FileType
getFileType OsPath
fp = do
  FileStatus
s <- PosixPath -> IO FileStatus
PosixF.getSymbolicLinkStatus (PosixPath -> IO FileStatus) -> PosixPath -> IO FileStatus
forall a b. (a -> b) -> a -> b
$ OsPath -> PosixPath
getOsString OsPath
fp
  case () of
    ()
_ | FileStatus -> Bool
PosixF.isRegularFile FileStatus
s  -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
regularFile
      | FileStatus -> Bool
PosixF.isDirectory FileStatus
s    -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
regularDirectory
      | FileStatus -> Bool
PosixF.isSymbolicLink FileStatus
s -> do
        Either IOException FileStatus
es' <- IO FileStatus -> IO (Either IOException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO FileStatus -> IO (Either IOException FileStatus))
-> IO FileStatus -> IO (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ PosixPath -> IO FileStatus
PosixF.getFileStatus (PosixPath -> IO FileStatus) -> PosixPath -> IO FileStatus
forall a b. (a -> b) -> a -> b
$ OsPath -> PosixPath
getOsString OsPath
fp
        case Either IOException FileStatus
es' of
          Left (IOException
_ :: IOException) -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
symlinkOther
          Right FileStatus
s'
            | FileStatus -> Bool
PosixF.isRegularFile FileStatus
s' -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
symlinkFile
            | FileStatus -> Bool
PosixF.isDirectory FileStatus
s'   -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
symlinkDirectory
            | Bool
otherwise               -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
symlinkOther
      | Bool
otherwise -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
regularOther
#endif

-- Avoid allocations with this one weird trick.
{-# NOINLINE regularFile #-}
{-# NOINLINE regularDirectory #-}
{-# NOINLINE symlinkFile #-}
{-# NOINLINE symlinkDirectory #-}
-- | Auxiliary constants to refer to different file types without
-- allocations.
regularFile, regularDirectory, regularOther, symlinkFile, symlinkDirectory, symlinkOther :: FileType
regularFile :: FileType
regularFile      = SymlinkType -> FileType
File SymlinkType
Regular
regularDirectory :: FileType
regularDirectory = SymlinkType -> FileType
Directory SymlinkType
Regular
regularOther :: FileType
regularOther     = SymlinkType -> FileType
Other SymlinkType
Regular
symlinkFile :: FileType
symlinkFile      = SymlinkType -> FileType
File SymlinkType
Symlink
symlinkDirectory :: FileType
symlinkDirectory = SymlinkType -> FileType
Directory SymlinkType
Symlink
symlinkOther :: FileType
symlinkOther     = SymlinkType -> FileType
Other SymlinkType
Symlink