{-# LANGUAGE CPP #-}

-- | @since 0.1
module PathSize
  ( -- * Types
    PathData (..),
    SubPathData (MkSubPathData),
    PathSizeResult (..),

    -- ** Configuration
    Config (..),
    Strategy (..),

    -- * High level functions
    findLargestPaths,
    pathSizeRecursive,
    pathSizeRecursiveConfig,
    SPD.display,

    -- * Errors
    PathE (..),
  )
where

import Data.HashSet qualified as HSet
import Data.Sequence (Seq (Empty, (:<|)))
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty (NESeq ((:<||)))
import Data.Word (Word16)
import Effects.Concurrent.Async (MonadAsync)
import Effects.Concurrent.Async qualified as Async
import Effects.Exception
  ( HasCallStack,
    MonadCatch,
    tryAny,
  )
import Effects.FileSystem.OsPath (OsPath, (</>))
import Effects.FileSystem.PathReader (MonadPathReader)
import Effects.FileSystem.PathReader qualified as RDir
import PathSize.Data.Config
  ( Config
      ( MkConfig,
        exclude,
        filesOnly,
        ignoreDirIntrinsicSize,
        maxDepth,
        numPaths,
        searchAll,
        stableSort,
        strategy
      ),
    Strategy (Async, AsyncPool, Sync),
    defaultNumPathsSize,
  )
import PathSize.Data.PathData
  ( PathData
      ( MkPathData,
        numDirectories,
        numFiles,
        path,
        size
      ),
  )
import PathSize.Data.PathSizeResult
  ( PathSizeResult
      ( PathSizeFailure,
        PathSizePartial,
        PathSizeSuccess
      ),
    mkPathE,
  )
import PathSize.Data.PathTree (PathTree ((:^|)))
import PathSize.Data.PathTree qualified as PathTree
import PathSize.Data.SubPathData qualified as SPD
import PathSize.Data.SubPathData.Internal (SubPathData (UnsafeSubPathData))
import PathSize.Exception (PathE (MkPathE))
import PathSize.Utils (MonadPosixC)
import PathSize.Utils qualified as Utils
import System.OsPath qualified as FP
import System.PosixCompat.Files qualified as PCompat.Files

{- HLINT ignore "Redundant bracket" -}

-- | Given a path, finds the size of all subpaths, recursively.
--
-- @since 0.1
findLargestPaths ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  -- | Configuration.
  Config ->
  -- | OsPath to search.
  OsPath ->
  -- | The results.
  m (PathSizeResult SubPathData)
findLargestPaths :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult SubPathData)
findLargestPaths Config
cfg = ((PathSizeResult PathTree -> PathSizeResult SubPathData)
-> m (PathSizeResult PathTree) -> m (PathSizeResult SubPathData)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PathSizeResult PathTree -> PathSizeResult SubPathData)
 -> m (PathSizeResult PathTree) -> m (PathSizeResult SubPathData))
-> ((PathTree -> SubPathData)
    -> PathSizeResult PathTree -> PathSizeResult SubPathData)
-> (PathTree -> SubPathData)
-> m (PathSizeResult PathTree)
-> m (PathSizeResult SubPathData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTree -> SubPathData)
-> PathSizeResult PathTree -> PathSizeResult SubPathData
forall a b. (a -> b) -> PathSizeResult a -> PathSizeResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) PathTree -> SubPathData
takeLargestN (m (PathSizeResult PathTree) -> m (PathSizeResult SubPathData))
-> (OsPath -> m (PathSizeResult PathTree))
-> OsPath
-> m (PathSizeResult SubPathData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OsPath -> m (PathSizeResult PathTree)
f Config
cfg
  where
    f :: Config -> OsPath -> m (PathSizeResult PathTree)
f = case Config
cfg.strategy of
      Strategy
Sync -> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveSync
      Strategy
Async -> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveAsync
      Strategy
AsyncPool -> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveAsyncPool
    takeLargestN :: PathTree -> SubPathData
takeLargestN =
      (PathTree -> SubPathData)
-> (Positive Int -> PathTree -> SubPathData)
-> Maybe (Positive Int)
-> PathTree
-> SubPathData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Bool -> PathTree -> SubPathData
SPD.mkSubPathData Config
cfg.stableSort)
        (HasCallStack => Bool -> Positive Int -> PathTree -> SubPathData
Bool -> Positive Int -> PathTree -> SubPathData
SPD.takeLargestN Config
cfg.stableSort)
        (Config
cfg.numPaths)
{-# INLINEABLE findLargestPaths #-}

-- | Returns the total path size in bytes. Calls 'pathSizeRecursiveConfig' with
-- the following config:
--
-- @
-- MkConfig
--   { searchAll = True,
--     maxDepth = Just 0,
--     exclude = [],
--     filesOnly = False,
--     ignoreDirIntrinsicSize = False,
--     numPaths = Just 1,
--     stableSort = False,
--     strategy = Async
--   }
-- @
--
-- @since 0.1
pathSizeRecursive ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  OsPath ->
  m (PathSizeResult Integer)
pathSizeRecursive :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
OsPath -> m (PathSizeResult Integer)
pathSizeRecursive = Config -> OsPath -> m (PathSizeResult Integer)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult Integer)
pathSizeRecursiveConfig Config
cfg
  where
    cfg :: Config
cfg =
      MkConfig
        { searchAll :: Bool
searchAll = Bool
True,
          maxDepth :: Maybe Word16
maxDepth = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
0,
          exclude :: HashSet OsPath
exclude = HashSet OsPath
forall a. Monoid a => a
mempty,
          filesOnly :: Bool
filesOnly = Bool
False,
          ignoreDirIntrinsicSize :: Bool
ignoreDirIntrinsicSize = Bool
False,
          numPaths :: Maybe (Positive Int)
numPaths = Positive Int -> Maybe (Positive Int)
forall a. a -> Maybe a
Just Positive Int
defaultNumPathsSize,
          stableSort :: Bool
stableSort = Bool
False,
          strategy :: Strategy
strategy = Strategy
Async
        }
{-# INLINEABLE pathSizeRecursive #-}

-- | Returns the total path size in bytes.
--
-- @since 0.1
pathSizeRecursiveConfig ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  Config ->
  OsPath ->
  m (PathSizeResult Integer)
pathSizeRecursiveConfig :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult Integer)
pathSizeRecursiveConfig Config
cfg = ((PathSizeResult SubPathData -> PathSizeResult Integer)
-> m (PathSizeResult SubPathData) -> m (PathSizeResult Integer)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PathSizeResult SubPathData -> PathSizeResult Integer)
 -> m (PathSizeResult SubPathData) -> m (PathSizeResult Integer))
-> ((SubPathData -> Integer)
    -> PathSizeResult SubPathData -> PathSizeResult Integer)
-> (SubPathData -> Integer)
-> m (PathSizeResult SubPathData)
-> m (PathSizeResult Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubPathData -> Integer)
-> PathSizeResult SubPathData -> PathSizeResult Integer
forall a b. (a -> b) -> PathSizeResult a -> PathSizeResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) SubPathData -> Integer
getSize (m (PathSizeResult SubPathData) -> m (PathSizeResult Integer))
-> (OsPath -> m (PathSizeResult SubPathData))
-> OsPath
-> m (PathSizeResult Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OsPath -> m (PathSizeResult SubPathData)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult SubPathData)
findLargestPaths Config
cfg
  where
    getSize :: SubPathData -> Integer
getSize (UnsafeSubPathData (PathData
pd :<|| Seq PathData
_)) = PathData
pd.size
{-# INLINEABLE pathSizeRecursiveConfig #-}

-- | Given a path, associates all subpaths to their size, recursively.
-- The searching is performed sequentially.
--
-- @since 0.1
pathDataRecursiveSync ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  Config ->
  OsPath ->
  m (PathSizeResult PathTree)
pathDataRecursiveSync :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveSync = (forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
(forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursive (a -> m b) -> t a -> m (t b)
forall a b (t :: * -> *).
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
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) -> t a -> f (t b)
traverse
{-# INLINEABLE pathDataRecursiveSync #-}

-- | Like 'pathDataRecursive', but each recursive call is run in its own
-- thread.
--
-- @since 0.1
pathDataRecursiveAsync ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  Config ->
  OsPath ->
  m (PathSizeResult PathTree)
pathDataRecursiveAsync :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveAsync = (forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
(forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursive (a -> m b) -> t a -> m (t b)
forall a b (t :: * -> *).
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) (t :: * -> *) a b.
(MonadAsync m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
Async.mapConcurrently
{-# INLINEABLE pathDataRecursiveAsync #-}

-- | Like 'pathDataRecursiveAsync', but runs with a thread pool.
--
-- @since 0.1
pathDataRecursiveAsyncPool ::
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  Config ->
  OsPath ->
  m (PathSizeResult PathTree)
pathDataRecursiveAsyncPool :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadPathReader m,
 MonadPosixC m) =>
Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursiveAsyncPool = (forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
(forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursive (a -> m b) -> t a -> m (t b)
forall a b (t :: * -> *).
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) (t :: * -> *) a b.
(MonadAsync m, HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
forall (t :: * -> *) a b.
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
Async.pooledMapConcurrently
{-# INLINEABLE pathDataRecursiveAsyncPool #-}

-- | Given a path, associates all subpaths to their size, recursively.
-- The searching is performed via the parameter traversal.
--
-- @since 0.1
{-# INLINEABLE pathDataRecursive #-}
pathDataRecursive ::
  forall m.
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m,
    MonadPosixC m
  ) =>
  -- | Traversal function.
  (forall a b t. (HasCallStack, Traversable t) => (a -> m b) -> t a -> m (t b)) ->
  -- | The config.
  Config ->
  -- | Start path.
  OsPath ->
  m (PathSizeResult PathTree)
pathDataRecursive :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m, MonadPosixC m) =>
(forall a b (t :: * -> *).
 (HasCallStack, Traversable t) =>
 (a -> m b) -> t a -> m (t b))
-> Config -> OsPath -> m (PathSizeResult PathTree)
pathDataRecursive forall a b (t :: * -> *).
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
traverseFn Config
cfg = HasCallStack => Word16 -> OsPath -> m (PathSizeResult PathTree)
Word16 -> OsPath -> m (PathSizeResult PathTree)
tryGo Word16
0
  where
    excluded :: HashSet OsPath
excluded = Config
cfg.exclude

    skipExcluded :: OsPath -> Bool
    skipExcluded :: OsPath -> Bool
skipExcluded = (OsPath -> HashSet OsPath -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HSet.member` HashSet OsPath
excluded)

    -- NOTE: [Directory sizes]
    dirSizeFn :: Integer -> Integer -> Integer
dirSizeFn
      -- filesOnly -> directories are set to size 0
      | Config
cfg.filesOnly = \Integer
_ Integer
_ -> Integer
0
      -- ignoreDirIntrinsicSize -> directories are set to subfiles size;
      -- intrinsic size of the dir itself is ignored. This relies on the
      -- _first_ param being the subfiles size.
      | Config
cfg.ignoreDirIntrinsicSize = Integer -> Integer -> Integer
forall a b. a -> b -> a
const
      | Bool
otherwise = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)

    -- NOTE: If a maxDepth is given, we do not include paths that exceed
    -- the depth. Note that they are still included in size calculation for
    -- parent directories.
    depthExceeded :: Word16 -> Bool
depthExceeded = case Config
cfg.maxDepth of
      Maybe Word16
Nothing -> Bool -> Word16 -> Bool
forall a b. a -> b -> a
const Bool
False
      Just Word16
d -> (Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
d)

    shouldSkip :: OsPath -> Bool
shouldSkip = case (Config
cfg.searchAll, HashSet OsPath -> Bool
forall a. HashSet a -> Bool
HSet.null HashSet OsPath
excluded) of
      -- 1. Search all and no excluded paths: no checks
      (Bool
True, Bool
True) -> Bool -> OsPath -> Bool
forall a b. a -> b -> a
const Bool
False
      -- 2. No search all: check hidden
      (Bool
False, Bool
True) -> OsPath -> Bool
Utils.hidden (OsPath -> Bool) -> (OsPath -> OsPath) -> OsPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
FP.takeFileName
      -- 3. Some excluded paths: check excluded
      (Bool
True, Bool
False) -> OsPath -> Bool
skipExcluded (OsPath -> Bool) -> (OsPath -> OsPath) -> OsPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
FP.takeFileName
      -- 4. No search all and some excluded paths: check hidden and excluded
      (Bool
False, Bool
False) -> (\OsPath
p -> OsPath -> Bool
Utils.hidden OsPath
p Bool -> Bool -> Bool
|| OsPath -> Bool
skipExcluded OsPath
p) (OsPath -> Bool) -> (OsPath -> OsPath) -> OsPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
FP.takeFileName

    -- Base recursive function. If the path is determined to be a symlink or
    -- file, calculates the size. If it is a directory, we recursively call
    -- tryGo on all subpaths.
    {-# INLINEABLE tryGo #-}
    tryGo ::
      (HasCallStack) =>
      Word16 ->
      OsPath ->
      m (PathSizeResult PathTree)
    tryGo :: HasCallStack => Word16 -> OsPath -> m (PathSizeResult PathTree)
tryGo !Word16
depth !OsPath
path =
      m FileStatus -> m (Either SomeException FileStatus)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (OsPath -> m FileStatus
forall (m :: * -> *).
(HasCallStack, MonadPosixC m) =>
OsPath -> m FileStatus
Utils.getFileStatus OsPath
path) m (Either SomeException FileStatus)
-> (Either SomeException FileStatus -> m (PathSizeResult PathTree))
-> m (PathSizeResult PathTree)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left SomeException
ex -> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathSizeResult PathTree -> m (PathSizeResult PathTree))
-> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a b. (a -> b) -> a -> b
$ OsPath -> SomeException -> PathSizeResult PathTree
forall e a. Exception e => OsPath -> e -> PathSizeResult a
mkPathE OsPath
path SomeException
ex
        Right FileStatus
stats -> do
          -- see NOTE: [Efficient Int Type]
          let size :: Integer
size = FileOffset -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Integer) -> FileOffset -> Integer
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileOffset
PCompat.Files.fileSize FileStatus
stats
          -- Treat all non-directories identically. getFileStatus already
          -- handles symbolic links for us (by using getSymbolicLinkStatus),
          -- There are still other file types e.g. named pipes, but I see no
          -- reason to differentiate here i.e. the only choice we have to make
          -- is directory vs. non-directory.
          if FileStatus -> Bool
PCompat.Files.isDirectory FileStatus
stats
            then HasCallStack =>
Integer -> OsPath -> Word16 -> m (PathSizeResult PathTree)
Integer -> OsPath -> Word16 -> m (PathSizeResult PathTree)
tryCalcDir Integer
size OsPath
path Word16
depth
            else
              PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathSizeResult PathTree -> m (PathSizeResult PathTree))
-> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a b. (a -> b) -> a -> b
$
                PathTree -> PathSizeResult PathTree
forall a. a -> PathSizeResult a
PathSizeSuccess (PathTree -> PathSizeResult PathTree)
-> PathTree -> PathSizeResult PathTree
forall a b. (a -> b) -> a -> b
$
                  PathData -> PathTree
PathTree.singleton (PathData -> PathTree) -> PathData -> PathTree
forall a b. (a -> b) -> a -> b
$
                    MkPathData
                      { OsPath
path :: OsPath
path :: OsPath
path,
                        Integer
size :: Integer
size :: Integer
size,
                        numFiles :: Integer
numFiles = Integer
1,
                        numDirectories :: Integer
numDirectories = Integer
0
                      }

    {-# INLINEABLE tryCalcDir #-}
    tryCalcDir ::
      ( HasCallStack
      ) =>
      Integer ->
      OsPath ->
      Word16 ->
      m (PathSizeResult PathTree)
    tryCalcDir :: HasCallStack =>
Integer -> OsPath -> Word16 -> m (PathSizeResult PathTree)
tryCalcDir !Integer
dirSize !OsPath
path !Word16
depth =
      m [OsPath] -> m (Either SomeException [OsPath])
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny ((OsPath -> Bool) -> [OsPath] -> [OsPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (OsPath -> Bool) -> OsPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Bool
shouldSkip) ([OsPath] -> [OsPath]) -> m [OsPath] -> m [OsPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
RDir.listDirectory OsPath
path) m (Either SomeException [OsPath])
-> (Either SomeException [OsPath] -> m (PathSizeResult PathTree))
-> m (PathSizeResult PathTree)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left SomeException
listDirEx -> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathSizeResult PathTree -> m (PathSizeResult PathTree))
-> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a b. (a -> b) -> a -> b
$ OsPath -> SomeException -> PathSizeResult PathTree
forall e a. Exception e => OsPath -> e -> PathSizeResult a
mkPathE OsPath
path SomeException
listDirEx
        Right [OsPath]
subPaths -> do
          Seq (PathSizeResult PathTree)
resultSubTrees <-
            (OsPath -> m (PathSizeResult PathTree))
-> Seq OsPath -> m (Seq (PathSizeResult PathTree))
forall a b (t :: * -> *).
(HasCallStack, Traversable t) =>
(a -> m b) -> t a -> m (t b)
traverseFn
              (HasCallStack => Word16 -> OsPath -> m (PathSizeResult PathTree)
Word16 -> OsPath -> m (PathSizeResult PathTree)
tryGo (Word16
depth Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) (OsPath -> m (PathSizeResult PathTree))
-> (OsPath -> OsPath) -> OsPath -> m (PathSizeResult PathTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OsPath
path </>))
              ([OsPath] -> Seq OsPath
forall a. [a] -> Seq a
Seq.fromList [OsPath]
subPaths)

          let (Seq PathE
errs, Seq PathTree
subTrees) = Seq (PathSizeResult PathTree) -> (Seq PathE, Seq PathTree)
Utils.unzipResultSeq Seq (PathSizeResult PathTree)
resultSubTrees
              (# !Integer
subSize, !Integer
numFiles, !Integer
subDirs #) = Seq PathTree -> (# Integer, Integer, Integer #)
PathTree.sumTrees Seq PathTree
subTrees
              !numDirectories :: Integer
numDirectories = Integer
subDirs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
              -- NOTE: subSize needs to be the first param to corrrectly
              -- account for ignoreDirIntrinsicSize.
              -- See NOTE: [Directory sizes]
              !size :: Integer
size = Integer -> Integer -> Integer
dirSizeFn Integer
subSize Integer
dirSize
              -- Do not report subpaths if the depth is exceeded.
              subTrees' :: Seq PathTree
subTrees'
                | Word16 -> Bool
depthExceeded Word16
depth = Seq PathTree
forall a. Seq a
Empty
                | Bool
otherwise = Seq PathTree
subTrees
              tree :: PathTree
tree =
                MkPathData
                  { OsPath
path :: OsPath
path :: OsPath
path,
                    Integer
size :: Integer
size :: Integer
size,
                    Integer
numFiles :: Integer
numFiles :: Integer
numFiles,
                    Integer
numDirectories :: Integer
numDirectories :: Integer
numDirectories
                  }
                  PathData -> Seq PathTree -> PathTree
:^| Seq PathTree
subTrees'
          PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathSizeResult PathTree -> m (PathSizeResult PathTree))
-> PathSizeResult PathTree -> m (PathSizeResult PathTree)
forall a b. (a -> b) -> a -> b
$ case Seq PathE
errs of
            Seq PathE
Empty -> PathTree -> PathSizeResult PathTree
forall a. a -> PathSizeResult a
PathSizeSuccess PathTree
tree
            (PathE
e :<| Seq PathE
es) -> NESeq PathE -> PathTree -> PathSizeResult PathTree
forall a. NESeq PathE -> a -> PathSizeResult a
PathSizePartial (PathE
e PathE -> Seq PathE -> NESeq PathE
forall a. a -> Seq a -> NESeq a
:<|| Seq PathE
es) PathTree
tree