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

{-# LANGUAGE CPP #-}

module System.Directory.OsPath.FileType
  ( FileType(..)
  , getFileType
  ) where

import System.OsPath.Types (OsPath)

#ifdef mingw32_HOST_OS

import System.Directory.OsPath (doesFileExist, doesDirectoryExist)

getFileType :: OsPath -> IO FileType
getFileType fp = do
  isFile <- doesFileExist fp
  if isFile
  then pure File
  else do
    isDir <- doesDirectoryExist fp
    pure $ if isDir then Directory else Other

#else

import Control.Exception (try, IOException)
import System.OsString.Internal.Types (getOsString)
import System.Posix.Files.PosixString qualified as PosixF

getFileType :: OsPath -> IO FileType
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
File
      | FileStatus -> Bool
PosixF.isDirectory FileStatus
s    -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
Directory
      | 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
Other
          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
FileSym
            | FileStatus -> Bool
PosixF.isDirectory FileStatus
s'   -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
DirectorySym
            | Bool
otherwise               -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
Other
      | Bool
otherwise -> FileType -> IO FileType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileType
Other

#endif

data FileType
  = File
  | FileSym -- ^ Symlink to a file.
  | Directory
  | DirectorySym -- ^ Symlink to a directory.
  | Other
  deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileType -> ShowS
showsPrec :: Int -> FileType -> ShowS
$cshow :: FileType -> String
show :: FileType -> String
$cshowList :: [FileType] -> ShowS
showList :: [FileType] -> ShowS
Show, ReadPrec [FileType]
ReadPrec FileType
Int -> ReadS FileType
ReadS [FileType]
(Int -> ReadS FileType)
-> ReadS [FileType]
-> ReadPrec FileType
-> ReadPrec [FileType]
-> Read FileType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FileType
readsPrec :: Int -> ReadS FileType
$creadList :: ReadS [FileType]
readList :: ReadS [FileType]
$creadPrec :: ReadPrec FileType
readPrec :: ReadPrec FileType
$creadListPrec :: ReadPrec [FileType]
readListPrec :: ReadPrec [FileType]
Read, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: FileType -> FileType -> Bool
Eq, Eq FileType
Eq FileType =>
(FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileType -> FileType -> Ordering
compare :: FileType -> FileType -> Ordering
$c< :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
>= :: FileType -> FileType -> Bool
$cmax :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
min :: FileType -> FileType -> FileType
Ord)