    -- |
    -- 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#, mutableByteArrayContents#, RealWorld)
    import GHC.IO (IO(..))
    import GHC.Int (Int(..))
    import GHC.Ptr (Ptr(..))

    import System.Directory.OsPath.Utils (touch)
    # 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
      stream <- PosixPath -> IO DirStream
    Posix.openDirStream (OsPath -> PosixPath
    getOsString OsPath
    root)
      pure $ RawDirStream stream 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
      cache <- IO DirReadCache
    allocateDirReadCache
      res   <- readRawDirStreamWithCache cache stream
      -- Safe to don’t care about exceptions because we know that cache is
      -- just a byte vector so just touch# it for now.
      releaseDirReadCache cache
      pure $ (\(OsPath
    _, Basename OsPath
    x, FileType
    typ) -> (OsPath
    x, FileType
    typ)) <$> 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 = pure $ DirReadCache ()
    # endif
    # ifdef HAVE_UNIX_CACHE
    allocateDirReadCache :: IO DirReadCache
    allocateDirReadCache = (State# RealWorld -> (# State# RealWorld, DirReadCache #))
    -> IO DirReadCache
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, DirReadCache #))
     -> IO DirReadCache)
    -> (State# RealWorld -> (# State# RealWorld, DirReadCache #))
    -> IO DirReadCache
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s0 ->
      case Int#
    -> Int#
    -> State# RealWorld
    -> (# State# RealWorld, MutableByteArray# RealWorld #)
    forall d.
    Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
    newAlignedPinnedByteArray# Int#
    size Int#
    align State# RealWorld
    s0 of
        (# State# RealWorld
    s1, MutableByteArray# RealWorld
    mbarr# #) ->
          (# State# RealWorld
    s1, MutableByteArray# RealWorld -> DirReadCache
    DirReadCache MutableByteArray# RealWorld
    mbarr# #)
      where
        !(I# Int#
    size)  = Ptr DirEnt -> Int
    forall a. Storable a => a -> Int
    sizeOf    (Ptr DirEnt
    forall a. HasCallStack => a
    undefined :: Ptr DirInternals.DirEnt)
        !(I# Int#
    align) = Ptr DirEnt -> Int
    forall a. Storable a => a -> Int
    alignment (Ptr DirEnt
    forall a. HasCallStack => a
    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 _ = pure ()
    # endif
    # ifdef HAVE_UNIX_CACHE
    releaseDirReadCache :: DirReadCache -> IO ()
    releaseDirReadCache = DirReadCache -> IO ()
    forall x. x -> IO ()
    touch
    # 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 _ stream@(RawDirStream _ root) = do
      traverse (\x -> let full = root </> x in (full, Basename x,) <$> getFileType full) =<< _readRawDirStreamSimple stream
    # endif
    # ifdef HAVE_UNIX_CACHE
    readRawDirStreamWithCache :: DirReadCache
    -> RawDirStream -> IO (Maybe (OsPath, Basename OsPath, FileType))
    readRawDirStreamWithCache (DirReadCache MutableByteArray# RealWorld
    barr#) (RawDirStream DirStream
    stream OsPath
    root) = IO (Maybe (OsPath, Basename OsPath, FileType))
    go
      where
        cache :: Ptr DirInternals.DirEnt
        cache :: Ptr DirEnt
    cache = Addr# -> Ptr DirEnt
    forall a. Addr# -> Ptr a
    Ptr (MutableByteArray# RealWorld -> Addr#
    forall d. MutableByteArray# d -> Addr#
    mutableByteArrayContents# MutableByteArray# RealWorld
    barr#)

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

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

              shouldSkip <- shouldSkipDirEntry namePtr

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

                let fullPath = OsPath
    root OsPath -> OsPath -> OsPath
    </> PosixPath -> OsPath
    forall a b. Coercible a b => a -> b
    coerce PosixPath
    path

                !typ  <- DirInternals.dirEntType dirEnt

                typ' <- case typ of
                  DirType
    DirInternals.UnknownType         -> OsPath -> IO FileType
    getFileType OsPath
    fullPath
                  DirType
    DirInternals.NamedPipeType       -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularOther
                  DirType
    DirInternals.CharacterDeviceType -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularOther
                  DirType
    DirInternals.DirectoryType       -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularDirectory
                  DirType
    DirInternals.BlockDeviceType     -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularOther
                  DirType
    DirInternals.RegularFileType     -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularFile
                  DirType
    DirInternals.SymbolicLinkType    -> OsPath -> IO FileType
    getFileType OsPath
    fullPath
                  DirType
    DirInternals.SocketType          -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularOther
                  DirType
    DirInternals.WhiteoutType        -> FileType -> IO FileType
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileType
    regularOther
                  -- Unaccounted type, probably should not happeen since the
                  -- list above is exhaustive.
                  DirType
    _                                -> OsPath -> IO FileType
    getFileType OsPath
    fullPath

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

          case x of
            Maybe (Maybe (OsPath, Basename OsPath, FileType))
    Nothing           -> Maybe (OsPath, Basename OsPath, FileType)
    -> IO (Maybe (OsPath, Basename OsPath, FileType))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (OsPath, Basename OsPath, FileType)
    forall a. Maybe a
    Nothing
            Just Maybe (OsPath, Basename OsPath, FileType)
    Nothing      -> IO (Maybe (OsPath, Basename OsPath, FileType))
    go
            Just res :: Maybe (OsPath, Basename OsPath, FileType)
    res@(Just (OsPath, Basename OsPath, FileType)
    _) -> Maybe (OsPath, Basename OsPath, FileType)
    -> IO (Maybe (OsPath, Basename OsPath, FileType))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (OsPath, Basename OsPath, FileType)
    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 = do
          fp <- Posix.readDirStream stream
          case () of
            _ | fp == mempty
              -> pure Nothing
              | fp == getOsString [osp|.|] || fp == getOsString [osp|..|]
              -> go
              | otherwise
              -> pure $ Just $ OsString fp
    # endif
    # ifdef HAVE_UNIX_CACHE
        go :: IO (Maybe OsPath)
    go = do
          fp <- DirStream -> IO (Maybe PosixPath)
    Posix.readDirStreamMaybe DirStream
    stream
          case fp of
            Maybe PosixPath
    Nothing -> 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
            Just PosixPath
    fp'
              | 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
    #endif