1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4-- | Streaming functions for interacting with the filesystem.
5module Data.Streaming.Filesystem
6    ( DirStream
7    , openDirStream
8    , readDirStream
9    , closeDirStream
10    , FileType (..)
11    , getFileType
12    ) where
13
14import Data.Typeable (Typeable)
15
16#if WINDOWS
17
18import qualified System.Win32 as Win32
19import System.FilePath ((</>))
20import Data.IORef (IORef, newIORef, readIORef, writeIORef)
21import System.Directory (doesFileExist, doesDirectoryExist)
22
23data DirStream = DirStream !Win32.HANDLE !Win32.FindData !(IORef Bool)
24    deriving Typeable
25
26openDirStream :: FilePath -> IO DirStream
27openDirStream fp = do
28    (h, fdat) <- Win32.findFirstFile $ fp </> "*"
29    imore <- newIORef True -- always at least two records, "." and ".."
30    return $! DirStream h fdat imore
31
32closeDirStream :: DirStream -> IO ()
33closeDirStream (DirStream h _ _) = Win32.findClose h
34
35readDirStream :: DirStream -> IO (Maybe FilePath)
36readDirStream ds@(DirStream h fdat imore) = do
37    more <- readIORef imore
38    if more
39        then do
40            filename <- Win32.getFindDataFileName fdat
41            Win32.findNextFile h fdat >>= writeIORef imore
42            if filename == "." || filename == ".."
43                then readDirStream ds
44                else return $ Just filename
45        else return Nothing
46
47isSymlink :: FilePath -> IO Bool
48isSymlink _ = return False
49
50getFileType :: FilePath -> IO FileType
51getFileType fp = do
52    isFile <- doesFileExist fp
53    if isFile
54        then return FTFile
55        else do
56            isDir <- doesDirectoryExist fp
57            return $ if isDir then FTDirectory else FTOther
58
59#else
60
61import System.Posix.Directory (DirStream, openDirStream, closeDirStream)
62import qualified System.Posix.Directory as Posix
63import qualified System.Posix.Files as PosixF
64import Control.Exception (try, IOException)
65
66readDirStream :: DirStream -> IO (Maybe FilePath)
67readDirStream ds = do
68    fp <- Posix.readDirStream ds
69    case fp of
70        "" -> return Nothing
71        "." -> readDirStream ds
72        ".." -> readDirStream ds
73        _ -> return $ Just fp
74
75getFileType :: FilePath -> IO FileType
76getFileType fp = do
77    s <- PosixF.getSymbolicLinkStatus fp
78    case () of
79        ()
80            | PosixF.isRegularFile s -> return FTFile
81            | PosixF.isDirectory s -> return FTDirectory
82            | PosixF.isSymbolicLink s -> do
83                es' <- try $ PosixF.getFileStatus fp
84                case es' of
85                    Left (_ :: IOException) -> return FTOther
86                    Right s'
87                        | PosixF.isRegularFile s' -> return FTFileSym
88                        | PosixF.isDirectory s' -> return FTDirectorySym
89                        | otherwise -> return FTOther
90            | otherwise -> return FTOther
91
92#endif
93
94data FileType
95    = FTFile
96    | FTFileSym -- ^ symlink to file
97    | FTDirectory
98    | FTDirectorySym -- ^ symlink to a directory
99    | FTOther
100    deriving (Show, Read, Eq, Ord, Typeable)
101