{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Internal module for 'SubPathData'. Provides the invariant-breaking
-- data constructor for 'SubPathData'.
--
-- @since 0.1
module PathSize.Data.SubPathData.Internal
  ( SubPathData (.., MkSubPathData),
    unSubPathData,
    mkSubPathData,
    takeLargestN,
    display,
  )
where

import Control.DeepSeq (NFData)
import Data.Bytes
  ( Bytes (MkBytes),
    FloatingFormatter (MkFloatingFormatter),
    Normalize (normalize),
    Size (B),
  )
import Data.Bytes qualified as Bytes
#if !MIN_VERSION_base(4, 20, 0)
import Data.Foldable (Foldable (foldl'))
#endif
import Data.Ord (Down (Down))
import Data.Sequence (Seq ((:<|)), (<|))
import Data.Sequence.NonEmpty (NESeq ((:<||)))
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text (Text)
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Effects.FileSystem.OsPath (OsPath)
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import GHC.Stack (HasCallStack)
import Numeric.Data.Positive (Positive (MkPositive))
import Optics.Core (A_Getter, LabelOptic (labelOptic), to)
import PathSize.Data.PathData
  ( PathData
      ( MkPathData,
        numDirectories,
        numFiles,
        path,
        size
      ),
  )
import PathSize.Data.PathTree (PathTree, pathTreeToSeq)
#if POSIX
import Data.ByteString.Short qualified as BS.Short
import System.OsString.Internal.Types
  ( OsString (getOsString),
    PosixString(getPosixString),
  )
import Effects.FileSystem.UTF8 qualified as FS.UTF8
#else
import Effects.FileSystem.OsPath qualified as FS.OsPath
#endif

-- | A flattened and sorted representation of 'PathTree'. Contains at least
-- one element.
--
-- @since 0.1
newtype SubPathData = UnsafeSubPathData (NESeq PathData)
  deriving stock
    ( -- | @since 0.1
      SubPathData -> SubPathData -> Bool
(SubPathData -> SubPathData -> Bool)
-> (SubPathData -> SubPathData -> Bool) -> Eq SubPathData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubPathData -> SubPathData -> Bool
== :: SubPathData -> SubPathData -> Bool
$c/= :: SubPathData -> SubPathData -> Bool
/= :: SubPathData -> SubPathData -> Bool
Eq,
      -- | @since 0.1
      (forall x. SubPathData -> Rep SubPathData x)
-> (forall x. Rep SubPathData x -> SubPathData)
-> Generic SubPathData
forall x. Rep SubPathData x -> SubPathData
forall x. SubPathData -> Rep SubPathData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubPathData -> Rep SubPathData x
from :: forall x. SubPathData -> Rep SubPathData x
$cto :: forall x. Rep SubPathData x -> SubPathData
to :: forall x. Rep SubPathData x -> SubPathData
Generic,
      -- | @since 0.1
      Int -> SubPathData -> ShowS
[SubPathData] -> ShowS
SubPathData -> String
(Int -> SubPathData -> ShowS)
-> (SubPathData -> String)
-> ([SubPathData] -> ShowS)
-> Show SubPathData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubPathData -> ShowS
showsPrec :: Int -> SubPathData -> ShowS
$cshow :: SubPathData -> String
show :: SubPathData -> String
$cshowList :: [SubPathData] -> ShowS
showList :: [SubPathData] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      SubPathData -> ()
(SubPathData -> ()) -> NFData SubPathData
forall a. (a -> ()) -> NFData a
$crnf :: SubPathData -> ()
rnf :: SubPathData -> ()
NFData
    )

-- | @since 0.1
instance HasField "unSubPathData" SubPathData (NESeq PathData) where
  getField :: SubPathData -> NESeq PathData
getField (UnsafeSubPathData NESeq PathData
xs) = NESeq PathData
xs

-- NOTE: This is hand-written because we want to use labeled optics and the
-- obvious strategy:
--
-- 1. Record selector unSubPathData
-- 2. TH generation
--
-- will require us to make the ordinary unSubPathData eliminator into an
-- unsafe record updater, which we do not want.

-- | @since 0.1
instance
  LabelOptic
    "unSubPathData"
    A_Getter
    SubPathData
    SubPathData
    (NESeq PathData)
    (NESeq PathData)
  where
  labelOptic :: Optic
  A_Getter
  NoIx
  SubPathData
  SubPathData
  (NESeq PathData)
  (NESeq PathData)
labelOptic = (SubPathData -> NESeq PathData)
-> Optic
     A_Getter
     NoIx
     SubPathData
     SubPathData
     (NESeq PathData)
     (NESeq PathData)
forall s a. (s -> a) -> Getter s a
to (\(UnsafeSubPathData NESeq PathData
sbd) -> NESeq PathData
sbd)

-- | Pattern synonym for 'SubPathData'. Note that construction sorts the
-- underlying 'NESeq', so it is not constant.
--
-- @since 0.1
pattern MkSubPathData :: NESeq PathData -> SubPathData
pattern $mMkSubPathData :: forall {r}.
SubPathData -> (NESeq PathData -> r) -> ((# #) -> r) -> r
$bMkSubPathData :: NESeq PathData -> SubPathData
MkSubPathData sbd <- UnsafeSubPathData sbd
  where
    MkSubPathData NESeq PathData
sbd = NESeq PathData -> SubPathData
UnsafeSubPathData (Bool -> NESeq PathData -> NESeq PathData
sortNESeq Bool
False NESeq PathData
sbd)

{-# COMPLETE MkSubPathData #-}

-- | @since 0.1
unSubPathData :: SubPathData -> NESeq PathData
unSubPathData :: SubPathData -> NESeq PathData
unSubPathData (UnsafeSubPathData NESeq PathData
sbd) = NESeq PathData
sbd

-- | Creates a 'SubPathData' from a 'PathTree'.
--
-- @since 0.1
mkSubPathData :: Bool -> PathTree -> SubPathData
mkSubPathData :: Bool -> PathTree -> SubPathData
mkSubPathData Bool
stableSort PathTree
tree = NESeq PathData -> SubPathData
UnsafeSubPathData (PathData
first PathData -> Seq PathData -> NESeq PathData
forall a. a -> Seq a -> NESeq a
:<|| Seq PathData
rest)
  where
    PathData
first :<|| Seq PathData
rest = Bool -> NESeq PathData -> NESeq PathData
sortNESeq Bool
stableSort (PathTree -> NESeq PathData
pathTreeToSeq PathTree
tree)

-- | Returns a 'Seq' representation of 'SubPathData'.
--
-- @since 0.1
subPathDataToSeq :: SubPathData -> Seq PathData
subPathDataToSeq :: SubPathData -> Seq PathData
subPathDataToSeq (UnsafeSubPathData (PathData
pd :<|| Seq PathData
xs)) = PathData
pd PathData -> Seq PathData -> Seq PathData
forall a. a -> Seq a -> Seq a
<| Seq PathData
xs

-- NOTE: Annoyingly, this sort seems to cost quite a bit of performance over
-- the previous (Down . view #size). It is now applying an additional sort
-- to the path. This was done initially to make testing easier (stable order
-- for paths w/ identical sizes), but the added determinism + usability
-- seems worth it.

-- | Sorts the path size.
--
-- @since 0.1
sortNESeq :: Bool -> NESeq PathData -> NESeq PathData
sortNESeq :: Bool -> NESeq PathData -> NESeq PathData
sortNESeq Bool
False = (PathData -> Down Integer) -> NESeq PathData -> NESeq PathData
forall b a. Ord b => (a -> b) -> NESeq a -> NESeq a
NESeq.sortOn PathData -> Down Integer
pathDataSizeOrd
sortNESeq Bool
True = (PathData -> Down (Integer, OsPath))
-> NESeq PathData -> NESeq PathData
forall b a. Ord b => (a -> b) -> NESeq a -> NESeq a
NESeq.sortOn PathData -> Down (Integer, OsPath)
pathDataSizePathOrd
{-# INLINEABLE sortNESeq #-}

pathDataSizeOrd :: PathData -> Down Integer
pathDataSizeOrd :: PathData -> Down Integer
pathDataSizeOrd = Integer -> Down Integer
forall a. a -> Down a
Down (Integer -> Down Integer)
-> (PathData -> Integer) -> PathData -> Down Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.size)
{-# INLINEABLE pathDataSizeOrd #-}

pathDataSizePathOrd :: PathData -> Down (Integer, OsPath)
pathDataSizePathOrd :: PathData -> Down (Integer, OsPath)
pathDataSizePathOrd = (Integer, OsPath) -> Down (Integer, OsPath)
forall a. a -> Down a
Down ((Integer, OsPath) -> Down (Integer, OsPath))
-> (PathData -> (Integer, OsPath))
-> PathData
-> Down (Integer, OsPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(MkPathData OsPath
p Integer
s Integer
_ Integer
_) -> (Integer
s, OsPath
p)
{-# INLINEABLE pathDataSizePathOrd #-}

{- HLINT ignore takeLargestN "Redundant bracket" -}

-- | Retrieves the largest N paths.
--
-- @since 0.1
takeLargestN :: (HasCallStack) => Bool -> Positive Int -> PathTree -> SubPathData
takeLargestN :: HasCallStack => Bool -> Positive Int -> PathTree -> SubPathData
takeLargestN Bool
stableSort (MkPositive Int
n) PathTree
tree = case Int -> NESeq PathData -> Seq PathData
forall a. Int -> NESeq a -> Seq a
NESeq.take Int
n NESeq PathData
sorted of
  (PathData
first :<| Seq PathData
rest) -> NESeq PathData -> SubPathData
UnsafeSubPathData (PathData
first PathData -> Seq PathData -> NESeq PathData
forall a. a -> Seq a -> NESeq a
:<|| Seq PathData
rest)
  -- NOTE: Should only happen if n == 0
  Seq PathData
_ ->
    String -> SubPathData
forall a. HasCallStack => String -> a
error (String -> SubPathData) -> String -> SubPathData
forall a b. (a -> b) -> a -> b
$
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"[PathSize.Data.SubPathData.Internal.takeLargestN]: ",
          String
Item [String]
"impossible, returned empty Seq for i = ",
          Int -> String
forall a. Show a => a -> String
show Int
n,
          String
Item [String]
", tree = ",
          PathTree -> String
forall a. Show a => a -> String
show PathTree
tree
        ]
  where
    sorted :: NESeq PathData
sorted = Bool -> NESeq PathData -> NESeq PathData
sortNESeq Bool
stableSort (PathTree -> NESeq PathData
pathTreeToSeq PathTree
tree)

-- | Displays the data.
--
-- @since 0.1
display :: Bool -> SubPathData -> Text
display :: Bool -> SubPathData -> Text
display Bool
revSort = Seq PathData -> Text
showList' (Seq PathData -> Text)
-> (SubPathData -> Seq PathData) -> SubPathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPathData -> Seq PathData
subPathDataToSeq
  where
    showList' :: Seq PathData -> Text
    showList' :: Seq PathData -> Text
showList' = LazyText -> Text
TL.toStrict (LazyText -> Text)
-> (Seq PathData -> LazyText) -> Seq PathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText (Builder -> LazyText)
-> (Seq PathData -> Builder) -> Seq PathData -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> Builder -> Builder)
-> Builder -> Seq PathData -> Builder
foldSeq PathData -> Builder -> Builder
go Builder
""
    go :: PathData -> Builder -> Builder
go (MkPathData {OsPath
path :: PathData -> OsPath
path :: OsPath
path, Integer
size :: PathData -> Integer
size :: Integer
size, Integer
numFiles :: PathData -> Integer
numFiles :: Integer
numFiles, Integer
numDirectories :: PathData -> Integer
numDirectories :: Integer
numDirectories}) Builder
acc =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ OsPath -> Builder
pathToBuilder OsPath
path,
          Builder
Item [Builder]
": ",
          LazyText -> Builder
TLB.fromLazyText (LazyText -> Builder) -> LazyText -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> LazyText
TL.fromStrict (Text -> LazyText) -> Text -> LazyText
forall a b. (a -> b) -> a -> b
$ Integer -> Text
formatSize Integer
size,
          Builder
Item [Builder]
", Directories: ",
          String -> Builder
TLB.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
numDirectories,
          Builder
Item [Builder]
", Files: ",
          String -> Builder
TLB.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
numFiles,
          Builder
Item [Builder]
"\n",
          Builder
Item [Builder]
acc
        ]

    formatSize :: Integer -> Text
    formatSize :: Integer -> Text
formatSize =
      BaseFormatter (Raw (SomeSize Double))
-> SizedFormatter -> SomeSize Double -> Text
forall a.
(Formatter (BaseFormatter (Raw a)), PrintfArg (Raw a),
 RawNumeric a, Sized a) =>
BaseFormatter (Raw a) -> SizedFormatter -> a -> Text
Bytes.formatSized
        (Maybe Word8 -> FloatingFormatter
MkFloatingFormatter (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2))
        SizedFormatter
Bytes.sizedFormatterUnix
        (SomeSize Double -> Text)
-> (Integer -> SomeSize Double) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes 'B Double -> Norm (Bytes 'B Double)
Bytes 'B Double -> SomeSize Double
forall a. Normalize a => a -> Norm a
normalize
        (Bytes 'B Double -> SomeSize Double)
-> (Integer -> Bytes 'B Double) -> Integer -> SomeSize Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Size) n. n -> Bytes s n
MkBytes @B
        (Double -> Bytes 'B Double)
-> (Integer -> Double) -> Integer -> Bytes 'B Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Double
    foldSeq :: (PathData -> Builder -> Builder)
-> Builder -> Seq PathData -> Builder
foldSeq
      | Bool
revSort = (Builder -> PathData -> Builder)
-> Builder -> Seq PathData -> Builder
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Builder -> PathData -> Builder)
 -> Builder -> Seq PathData -> Builder)
-> ((PathData -> Builder -> Builder)
    -> Builder -> PathData -> Builder)
-> (PathData -> Builder -> Builder)
-> Builder
-> Seq PathData
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> Builder -> Builder) -> Builder -> PathData -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip
      | Bool
otherwise = (PathData -> Builder -> Builder)
-> Builder -> Seq PathData -> Builder
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr

pathToBuilder :: OsPath -> TLB.Builder

#if POSIX
pathToBuilder :: OsPath -> Builder
pathToBuilder =
  Text -> Builder
TLB.fromText
    (Text -> Builder) -> (OsPath -> Text) -> OsPath -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
FS.UTF8.decodeUtf8Lenient
    (ByteString -> Text) -> (OsPath -> ByteString) -> OsPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
BS.Short.fromShort
    (ShortByteString -> ByteString)
-> (OsPath -> ShortByteString) -> OsPath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\OsPath
p -> OsPath
p.getOsString.getPosixString)
#else
pathToBuilder = TLB.fromString . FS.OsPath.decodeLenient
#endif