{-# LANGUAGE CPP #-}

-- | Provides utilities.
--
-- @since 0.1
module PathSize.Utils
  ( -- * Windows / Unix compat
    MonadPosixC,
    hidden,
    getFileStatus,

    -- * Misc
    unzipResultSeq,
  )
where

#if !MIN_VERSION_base(4, 20, 0)
import Data.Foldable (foldl')
#endif
import Data.Sequence (Seq (Empty, (:<|)))
import Data.Sequence.NonEmpty (NESeq ((:<||)))
import Effects.FileSystem.OsPath (OsPath)
import PathSize.Data.PathSizeResult
  ( PathSizeResult
      ( PathSizeFailure,
        PathSizePartial,
        PathSizeSuccess
      ),
  )
import PathSize.Data.PathTree (PathTree)
import PathSize.Exception (PathE)
import System.PosixCompat.Files (FileStatus)

#if POSIX
import Effects.Exception (HasCallStack)
import Effects.System.Posix (MonadPosix)
import Effects.System.Posix qualified as Posix
import System.OsString.Internal.Types
  ( OsString (getOsString),
    PosixString(getPosixString),
  )
#if OS_STRING
import System.OsString.Data.ByteString.Short qualified as Short
#else
import System.OsPath.Data.ByteString.Short qualified as Short
#endif
#else
import Effects.Exception (HasCallStack, MonadThrow)
import Effects.FileSystem.OsPath qualified as FS.OsPath
import Effects.System.PosixCompat (MonadPosixCompat)
import Effects.System.PosixCompat qualified as PosixCompat
#endif

-- | Unzips a sequence of results.
--
-- @since 0.1
unzipResultSeq :: Seq (PathSizeResult PathTree) -> (Seq PathE, Seq PathTree)
unzipResultSeq :: Seq (PathSizeResult PathTree) -> (Seq PathE, Seq PathTree)
unzipResultSeq = ((Seq PathE, Seq PathTree)
 -> PathSizeResult PathTree -> (Seq PathE, Seq PathTree))
-> (Seq PathE, Seq PathTree)
-> Seq (PathSizeResult PathTree)
-> (Seq PathE, Seq PathTree)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq PathE, Seq PathTree)
-> PathSizeResult PathTree -> (Seq PathE, Seq PathTree)
forall {a}.
(Seq PathE, Seq a) -> PathSizeResult a -> (Seq PathE, Seq a)
f (Seq PathE
forall a. Seq a
Empty, Seq PathTree
forall a. Seq a
Empty)
  where
    f :: (Seq PathE, Seq a) -> PathSizeResult a -> (Seq PathE, Seq a)
f (Seq PathE
errs, Seq a
trees) = \case
      PathSizeSuccess a
tree -> (Seq PathE
errs, a
tree a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
trees)
      PathSizePartial (PathE
e :<|| Seq PathE
es) a
tree -> (PathE
e PathE -> Seq PathE -> Seq PathE
forall a. a -> Seq a -> Seq a
:<| Seq PathE
es Seq PathE -> Seq PathE -> Seq PathE
forall a. Semigroup a => a -> a -> a
<> Seq PathE
errs, a
tree a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
trees)
      PathSizeFailure (PathE
e :<|| Seq PathE
es) -> (PathE
e PathE -> Seq PathE -> Seq PathE
forall a. a -> Seq a -> Seq a
:<| Seq PathE
es Seq PathE -> Seq PathE -> Seq PathE
forall a. Semigroup a => a -> a -> a
<> Seq PathE
errs, Seq a
trees)

-- | Detects hidden paths via a rather crude 'dot' check, with an
-- exception for the current directory ./.
--
-- @since 0.1
hidden :: OsPath -> Bool
#if POSIX
hidden :: OsPath -> Bool
hidden OsPath
p = case ShortByteString -> Maybe (Word8, Word8, ShortByteString)
Short.uncons2 ShortByteString
sbs of
  Maybe (Word8, Word8, ShortByteString)
Nothing -> Bool
False
  Just (Word8
46, Word8
47, ShortByteString
_) -> Bool
False -- "./"
  Just (Word8
46, Word8
_, ShortByteString
_) -> Bool
True   -- "."
  Just (Word8, Word8, ShortByteString)
_ -> Bool
False
  where
    sbs :: ShortByteString
sbs = OsPath
p.getOsString.getPosixString
#else
hidden = const False
#endif

{- ORMOLU_DISABLE -}

-- | Alias for MonadPosix* constraints. On Posix, this is MonadPosix (unix),
-- which allows for greater efficiency. On Windows, this is just
-- MonadPosixCompat (unix-compat).
type MonadPosixC m =
#if POSIX
  MonadPosix m
#else
  MonadPosixCompat m
#endif

{- ORMOLU_ENABLE -}

#if POSIX
-- | Retrieves the FileStatus for the given path.
--
-- @since 0.1
getFileStatus ::
  forall m.
  ( HasCallStack,
    MonadPosixC m
  ) =>
  OsPath ->
  m FileStatus
getFileStatus :: forall (m :: * -> *).
(HasCallStack, MonadPosixC m) =>
OsPath -> m FileStatus
getFileStatus OsPath
path =
  -- NOTE: On posix, we can take advantage of the fact that we know OsPath
  -- is a PosixString. This means we can call the unix library directly,
  -- saving expensive @OsPath -> FilePath (unix-compat)@ and
  -- @FilePath -> PosixString (unix)@ conversions.
  --
  -- Because we are getting the FileStatus directly, we also have more
  -- freedom to change the underlying size type for more potential
  -- efficiency gains, as we have one fewer fromIntegral call. The normal
  -- getFileSize already converts the stats to Integer, which is wasted if
  -- that's not the type we want.
  PlatformString -> m FileStatus
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PlatformString -> m FileStatus
Posix.getSymbolicLinkStatus OsPath
path.getOsString
#else
-- | Retrieves the FileStatus for the given path.
--
-- @since 0.1
getFileStatus ::
  forall m.
  ( HasCallStack,
    MonadPosixC m,
    MonadThrow m
  ) =>
  OsPath ->
  m FileStatus
getFileStatus path = do
  -- It would be nice if we could do something similar here i.e. take advantage
  -- of the fact that we know OsPath is a WindowsString and call the relevant
  -- function directly. Alas, the getSymbolicLinkStatus logic in PosixCompat
  -- is bespoke, and there does not appear to be a drop-in replacement
  -- @getSymbolicLinkStatus :: WindowsString -> IO FileStatus@ in Wind32.
  fp <- FS.OsPath.decodeThrowM path
  PosixCompat.getSymbolicLinkStatus fp
#endif