{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Streaming functions for interacting with the filesystem.
module Data.Streaming.Filesystem
    ( DirStream
    , openDirStream
    , readDirStream
    , closeDirStream
    , FileType (..)
    , getFileType
    ) where

import Data.Typeable (Typeable)

#if WINDOWS

import qualified System.Win32 as Win32
import System.FilePath ((</>))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import System.Directory (doesFileExist, doesDirectoryExist)

data DirStream = DirStream !Win32.HANDLE !Win32.FindData !(IORef Bool)
    deriving Typeable

openDirStream :: FilePath -> IO DirStream
openDirStream fp = do
    (h, fdat) <- Win32.findFirstFile $ fp </> "*"
    imore <- newIORef True -- always at least two records, "." and ".."
    return $! DirStream h fdat imore

closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream h _ _) = Win32.findClose h

readDirStream :: DirStream -> IO (Maybe FilePath)
readDirStream ds@(DirStream h fdat imore) = do
    more <- readIORef imore
    if more
        then do
            filename <- Win32.getFindDataFileName fdat
            Win32.findNextFile h fdat >>= writeIORef imore
            if filename == "." || filename == ".."
                then readDirStream ds
                else return $ Just filename
        else return Nothing

isSymlink :: FilePath -> IO Bool
isSymlink _ = return False

getFileType :: FilePath -> IO FileType
getFileType fp = do
    isFile <- doesFileExist fp
    if isFile
        then return FTFile
        else do
            isDir <- doesDirectoryExist fp
            return $ if isDir then FTDirectory else FTOther

#else

import System.Posix.Directory (DirStream, openDirStream, closeDirStream)
import qualified System.Posix.Directory as Posix
import qualified System.Posix.Files as PosixF
import Control.Exception (try, IOException)

readDirStream :: DirStream -> IO (Maybe FilePath)
readDirStream :: DirStream -> IO (Maybe FilePath)
readDirStream DirStream
ds = do
    FilePath
fp <- DirStream -> IO FilePath
Posix.readDirStream DirStream
ds
    case FilePath
fp of
        FilePath
"" -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
        FilePath
"." -> DirStream -> IO (Maybe FilePath)
readDirStream DirStream
ds
        FilePath
".." -> DirStream -> IO (Maybe FilePath)
readDirStream DirStream
ds
        FilePath
_ -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp

getFileType :: FilePath -> IO FileType
getFileType :: FilePath -> IO FileType
getFileType FilePath
fp = do
    FileStatus
s <- FilePath -> IO FileStatus
PosixF.getSymbolicLinkStatus FilePath
fp
    case () of
        ()
            | FileStatus -> Bool
PosixF.isRegularFile FileStatus
s -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTFile
            | FileStatus -> Bool
PosixF.isDirectory FileStatus
s -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTDirectory
            | 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
$ FilePath -> IO FileStatus
PosixF.getFileStatus FilePath
fp
                case Either IOException FileStatus
es' of
                    Left (IOException
_ :: IOException) -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTOther
                    Right FileStatus
s'
                        | FileStatus -> Bool
PosixF.isRegularFile FileStatus
s' -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTFileSym
                        | FileStatus -> Bool
PosixF.isDirectory FileStatus
s' -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTDirectorySym
                        | Bool
otherwise -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTOther
            | Bool
otherwise -> FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
FTOther

#endif

data FileType
    = FTFile
    | FTFileSym -- ^ symlink to file
    | FTDirectory
    | FTDirectorySym -- ^ symlink to a directory
    | FTOther
    deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> FilePath
(Int -> FileType -> ShowS)
-> (FileType -> FilePath) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> FilePath
$cshow :: FileType -> FilePath
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [FileType]
$creadListPrec :: ReadPrec [FileType]
readPrec :: ReadPrec FileType
$creadPrec :: ReadPrec FileType
readList :: ReadS [FileType]
$creadList :: ReadS [FileType]
readsPrec :: Int -> ReadS FileType
$creadsPrec :: Int -> ReadS FileType
Read, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: 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
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$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
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
$cp1Ord :: Eq FileType
Ord, Typeable)