-- |
-- Module:     System.Directory.OsPath.Streaming.Internal.Raw
-- Copyright:  (c) Sergey Vinokurov 2024
-- License:    Apache-2.0 (see LICENSE)
-- Maintainer: serg.foo@gmail.com
--
-- Streaming functions for interacting with the filesystem.
--
-- These do the basic job of reading directory entries but care must
-- be taken to not close these streams more than once.

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE UnboxedTuples       #-}

#ifndef mingw32_HOST_OS
# if MIN_VERSION_unix(2, 8, 6) && __GLASGOW_HASKELL__ >= 902
#  define HAVE_UNIX_CACHE 1
# endif
#endif

module System.Directory.OsPath.Streaming.Internal.Raw
  ( RawDirStream(..)
  , openRawDirStream
  , readRawDirStream
  , closeRawDirStream

  , DirReadCache(..)
  , allocateDirReadCache
  , releaseDirReadCache
  , readRawDirStreamWithCache
  ) where

import System.OsPath (osp, (</>))

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

-- Don’t use #else to make treesitter do better job - it parses #else part as comments.
#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

# ifdef HAVE_UNIX_CACHE
import Data.Coerce (coerce)
import Foreign.C (CString, CChar)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (sizeOf, alignment, peekElemOff)
import qualified System.Posix.Directory.Internals as DirInternals
import System.Posix.PosixPath.FilePath (peekFilePath)

import GHC.Exts (MutableByteArray#, newAlignedPinnedByteArray#, touch#, mutableByteArrayContents#, RealWorld)
import GHC.IO (IO(..))
import GHC.Int (Int(..))
import GHC.Ptr (Ptr(..))
# endif
#endif

-- | Abstract handle to directory contents.
--
-- Not thread safe and shouldn't be closed more than once.

#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 -- always at least two records, "." and ".."
  pure $! RawDirStream h fdat hasMore 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
root
#endif

-- | Deallocate directory handle. It’s not safe to call multiple times
-- on the same handle.
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, FileType))
readRawDirStream :: RawDirStream -> IO (Maybe (OsPath, FileType))
readRawDirStream RawDirStream
stream = do
  DirReadCache
cache <- IO DirReadCache
allocateDirReadCache
  Maybe (OsPath, Basename OsPath, FileType)
res   <- DirReadCache
-> RawDirStream -> IO (Maybe (OsPath, Basename OsPath, FileType))
readRawDirStreamWithCache DirReadCache
cache RawDirStream
stream
  -- Safe to don’t care about exceptions because we know that cache is
  -- just a byte vector so just touch# it for now.
  DirReadCache -> IO ()
releaseDirReadCache DirReadCache
cache
  Maybe (OsPath, FileType) -> IO (Maybe (OsPath, FileType))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OsPath, FileType) -> IO (Maybe (OsPath, FileType)))
-> Maybe (OsPath, FileType) -> IO (Maybe (OsPath, FileType))
forall a b. (a -> b) -> a -> b
$ (\(OsPath
_, Basename OsPath
x, FileType
typ) -> (OsPath
x, FileType
typ)) ((OsPath, Basename OsPath, FileType) -> (OsPath, FileType))
-> Maybe (OsPath, Basename OsPath, FileType)
-> Maybe (OsPath, FileType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (OsPath, Basename OsPath, FileType)
res

#ifdef mingw32_HOST_OS
-- No state on Windows
newtype DirReadCache = DirReadCache ()
#endif

#ifndef mingw32_HOST_OS

# ifndef HAVE_UNIX_CACHE
-- No state in early unix package
newtype DirReadCache = DirReadCache ()
# endif

# ifdef HAVE_UNIX_CACHE
data DirReadCache = DirReadCache (MutableByteArray# RealWorld)
# endif

#endif


allocateDirReadCache :: IO DirReadCache
#ifdef mingw32_HOST_OS
allocateDirReadCache = pure $ DirReadCache ()
#endif

#ifndef mingw32_HOST_OS
# ifndef HAVE_UNIX_CACHE
allocateDirReadCache :: IO DirReadCache
allocateDirReadCache = DirReadCache -> IO DirReadCache
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirReadCache -> IO DirReadCache)
-> DirReadCache -> IO DirReadCache
forall a b. (a -> b) -> a -> b
$ () -> DirReadCache
DirReadCache ()
# endif
# ifdef HAVE_UNIX_CACHE
allocateDirReadCache = IO $ \s0 ->
  case newAlignedPinnedByteArray# size align s0 of
    (# s1, mbarr# #) ->
      (# s1, DirReadCache mbarr# #)
  where
    !(I# size)  = sizeOf    (undefined :: Ptr DirInternals.DirEnt)
    !(I# align) = alignment (undefined :: Ptr DirInternals.DirEnt)
# endif
#endif


releaseDirReadCache :: DirReadCache -> IO ()
#ifdef mingw32_HOST_OS
releaseDirReadCache _ = pure ()
#endif
#ifndef mingw32_HOST_OS

# ifndef HAVE_UNIX_CACHE
releaseDirReadCache :: DirReadCache -> IO ()
releaseDirReadCache DirReadCache
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
# endif
# ifdef HAVE_UNIX_CACHE
releaseDirReadCache (DirReadCache barr#) =
  IO $ \s0 -> case touch# barr# s0 of s1 -> (# s1, () #)
# endif
#endif


readRawDirStreamWithCache
  :: DirReadCache
  -> RawDirStream
  -> IO (Maybe (OsPath, Basename OsPath, FileType))
#ifdef mingw32_HOST_OS
readRawDirStreamWithCache _ stream@(RawDirStream _ _ _ root) = do
  traverse (\x -> let full = root </> x in (full, Basename x,) <$> getFileType full) =<< _readRawDirStreamSimple stream
#endif
#ifndef mingw32_HOST_OS

# ifndef HAVE_UNIX_CACHE
readRawDirStreamWithCache :: DirReadCache
-> RawDirStream -> IO (Maybe (OsPath, Basename OsPath, FileType))
readRawDirStreamWithCache DirReadCache
_ stream :: RawDirStream
stream@(RawDirStream DirStream
_ OsPath
root) = do
  (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
</> 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) (Maybe OsPath -> IO (Maybe (OsPath, Basename OsPath, FileType)))
-> IO (Maybe OsPath)
-> IO (Maybe (OsPath, Basename OsPath, FileType))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawDirStream -> IO (Maybe OsPath)
_readRawDirStreamSimple RawDirStream
stream
# endif
# ifdef HAVE_UNIX_CACHE
readRawDirStreamWithCache (DirReadCache barr#) (RawDirStream stream root) = go
  where
    cache :: Ptr DirInternals.DirEnt
    cache = Ptr (mutableByteArrayContents# barr#)

    shouldSkipDirEntry :: CString -> IO Bool
    shouldSkipDirEntry ptr
      | ptr == nullPtr = pure True
    shouldSkipDirEntry ptr = do
      (x1 :: CChar) <- peekElemOff ptr 0
      case x1 of
        0  -> pure False
        46 -> do -- ASCII for ‘.’
          (x2 :: CChar) <- peekElemOff ptr 1
          case x2 of
            0  -> pure True
            46 -> do -- ASCII for ‘.’
              (x3 :: CChar) <- peekElemOff ptr 2
              pure $! x3 == 0
            _  -> pure False
        _  -> pure False

    go :: IO (Maybe (OsPath, Basename OsPath, FileType))
    go = do
      x <- DirInternals.readDirStreamWithPtr
        cache
        (\dirEnt -> do
          (namePtr :: CString) <- DirInternals.dirEntName dirEnt

          shouldSkip <- shouldSkipDirEntry namePtr

          if shouldSkip
          then
            pure Nothing
          else do
            !path <- peekFilePath namePtr

            let fullPath = root </> coerce path

            !typ  <- DirInternals.dirEntType dirEnt

            typ' <- case typ of
              DirInternals.UnknownType         -> getFileType fullPath
              DirInternals.NamedPipeType       -> pure regularOther
              DirInternals.CharacterDeviceType -> pure regularOther
              DirInternals.DirectoryType       -> pure regularDirectory
              DirInternals.BlockDeviceType     -> pure regularOther
              DirInternals.RegularFileType     -> pure regularFile
              DirInternals.SymbolicLinkType    -> getFileType fullPath
              DirInternals.SocketType          -> pure regularOther
              DirInternals.WhiteoutType        -> pure regularOther
              -- Unaccounted type, probably should not happeen since the
              -- list above is exhaustive.
              _                                -> getFileType fullPath

            pure (Just (fullPath, Basename $ coerce path, typ')))
        stream

      case x of
        Nothing           -> pure Nothing
        Just Nothing      -> go
        Just res@(Just _) -> pure res
# endif
#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
# ifndef HAVE_UNIX_CACHE
    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
# ifdef HAVE_UNIX_CACHE
    go = do
      fp <- Posix.readDirStreamMaybe stream
      case fp of
        Nothing -> pure Nothing
        Just fp'
          | fp' == getOsString [osp|.|] || fp' == getOsString [osp|..|]
          -> go
          | otherwise
          -> pure $ Just $ OsString fp'
# endif
#endif