{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UnboxedTuples #-}
module System.Directory.OsPath.Streaming.Internal.Raw
( RawDirStream(..)
, openRawDirStream
, readRawDirStream
, closeRawDirStream
) where
import System.OsPath (osp, addTrailingPathSeparator)
import System.Directory.OsPath.FileType
import System.Directory.OsPath.Types
#ifdef mingw32_HOST_OS
import Control.Concurrent.Counter (Counter)
import qualified Control.Concurrent.Counter as Counter
import Control.Monad (unless)
import System.OsPath.Types (OsPath)
import System.OsString.Internal.Types (OsString(OsString), getOsString)
import System.OsString.Windows (pstr)
import qualified System.Win32.Types as Win32
import qualified System.Win32.WindowsString.File as Win32
#endif
#ifndef mingw32_HOST_OS
import System.OsPath.Types (OsPath)
import System.OsString.Internal.Types (OsString(OsString), getOsString)
import qualified System.Posix.Directory.PosixPath as Posix
#endif
#ifdef mingw32_HOST_OS
data RawDirStream = RawDirStream !Win32.HANDLE !Win32.FindData !Counter !OsPath
#endif
#ifndef mingw32_HOST_OS
data RawDirStream = RawDirStream !Posix.DirStream !OsPath
#endif
openRawDirStream :: OsPath -> IO RawDirStream
#ifdef mingw32_HOST_OS
openRawDirStream fp = do
(h, fdat) <- Win32.findFirstFile $ getOsString fp <> [pstr|\*|]
hasMore <- Counter.new 1
pure $! RawDirStream h fdat hasMore $ addTrailingPathSeparator fp
#endif
#ifndef mingw32_HOST_OS
openRawDirStream :: OsPath -> IO RawDirStream
openRawDirStream OsPath
root = do
DirStream
stream <- PosixPath -> IO DirStream
Posix.openDirStream (OsPath -> PosixPath
getOsString OsPath
root)
RawDirStream -> IO RawDirStream
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawDirStream -> IO RawDirStream)
-> RawDirStream -> IO RawDirStream
forall a b. (a -> b) -> a -> b
$ DirStream -> OsPath -> RawDirStream
RawDirStream DirStream
stream (OsPath -> RawDirStream) -> OsPath -> RawDirStream
forall a b. (a -> b) -> a -> b
$ OsPath -> OsPath
addTrailingPathSeparator OsPath
root
#endif
closeRawDirStream :: RawDirStream -> IO ()
#ifdef mingw32_HOST_OS
closeRawDirStream (RawDirStream h _ _ _) = Win32.findClose h
#endif
#ifndef mingw32_HOST_OS
closeRawDirStream :: RawDirStream -> IO ()
closeRawDirStream (RawDirStream DirStream
stream OsPath
_) = DirStream -> IO ()
Posix.closeDirStream DirStream
stream
#endif
readRawDirStream
:: RawDirStream
-> IO (Maybe (OsPath, Basename OsPath, FileType))
#ifdef mingw32_HOST_OS
readRawDirStream stream@(RawDirStream _ _ _ root) =
readRawDirStreamSimple stream >>=
traverse (\x -> let full = root <> x in (full, Basename x,) <$> getFileType full)
#endif
#ifndef mingw32_HOST_OS
readRawDirStream :: RawDirStream -> IO (Maybe (OsPath, Basename OsPath, FileType))
readRawDirStream stream :: RawDirStream
stream@(RawDirStream DirStream
_ OsPath
root) =
RawDirStream -> IO (Maybe OsPath)
readRawDirStreamSimple RawDirStream
stream IO (Maybe OsPath)
-> (Maybe OsPath -> IO (Maybe (OsPath, Basename OsPath, FileType)))
-> IO (Maybe (OsPath, Basename OsPath, FileType))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(OsPath -> IO (OsPath, Basename OsPath, FileType))
-> Maybe OsPath -> IO (Maybe (OsPath, Basename OsPath, FileType))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (\OsPath
x -> let full :: OsPath
full = OsPath
root OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<> OsPath
x in (OsPath
full, OsPath -> Basename OsPath
forall a. a -> Basename a
Basename OsPath
x,) (FileType -> (OsPath, Basename OsPath, FileType))
-> IO FileType -> IO (OsPath, Basename OsPath, FileType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> IO FileType
getFileType OsPath
full)
#endif
readRawDirStreamSimple :: RawDirStream -> IO (Maybe OsPath)
#ifdef mingw32_HOST_OS
readRawDirStreamSimple (RawDirStream h fdat hasMore _) = go
where
go = do
hasMore' <- Counter.get hasMore
if hasMore' /= 0
then do
filename <- Win32.getFindDataFileName fdat
hasMore'' <- Win32.findNextFile h fdat
unless hasMore'' $
Counter.set hasMore 0
if filename == getOsString [osp|.|] || filename == getOsString [osp|..|]
then go
else pure $ Just $ OsString filename
else pure Nothing
#endif
#ifndef mingw32_HOST_OS
readRawDirStreamSimple :: RawDirStream -> IO (Maybe OsPath)
readRawDirStreamSimple (RawDirStream DirStream
stream OsPath
_) = IO (Maybe OsPath)
go
where
go :: IO (Maybe OsPath)
go = do
PosixPath
fp <- DirStream -> IO PosixPath
Posix.readDirStream DirStream
stream
case () of
()
_ | PosixPath
fp PosixPath -> PosixPath -> Bool
forall a. Eq a => a -> a -> Bool
== PosixPath
forall a. Monoid a => a
mempty
-> Maybe OsPath -> IO (Maybe OsPath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OsPath
forall a. Maybe a
Nothing
| PosixPath
fp PosixPath -> PosixPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath -> PosixPath
getOsString [osp|.|] Bool -> Bool -> Bool
|| PosixPath
fp PosixPath -> PosixPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath -> PosixPath
getOsString [osp|..|]
-> IO (Maybe OsPath)
go
| Bool
otherwise
-> Maybe OsPath -> IO (Maybe OsPath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OsPath -> IO (Maybe OsPath))
-> Maybe OsPath -> IO (Maybe OsPath)
forall a b. (a -> b) -> a -> b
$ OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just (OsPath -> Maybe OsPath) -> OsPath -> Maybe OsPath
forall a b. (a -> b) -> a -> b
$ PosixPath -> OsPath
OsString PosixPath
fp
#endif