Show size of each gcroot that is not in any previous gcroot
import Data.Aeson qualified as Aeson
import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), (.:), (.=), object)
import Data.Aeson.Types (prependFailure, typeMismatch)
+import Data.Set (Set)
+import Data.Set qualified as Set
import Data.Text (Text)
import GHC.Base (quotInt)
-import Relude (catMaybes, foldMapM, sortWith)
+import Relude (catMaybes, foldMapM, sortWith, mapAccumL)
import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
import System.IO (stderr, hPutStrLn)
import System.Posix.Files qualified as Posix
import System.Process.Typed (readProcess_, proc)
import System.ProgressBar (hNewProgressBar)
import System.ProgressBar qualified as ProgressBar
+import Text.Printf (printf)
main :: IO ()
main = do
hPutStrLn stderr "Scanning gcroots..."
pb <- hNewProgressBar stderr ProgressBar.defStyle 10 (ProgressBar.Progress 0 (length gcrootPaths) ())
gcroots <- catMaybes <$> mapM (collectAndLog pb) gcrootPaths
- let sorted = sortWith (negate . totalSize . gcrootDependencies) gcroots
- mapM_ printGcroot sorted
+ let sorted = sortWith sortRootKey gcroots
+ let (_, final) = mapAccumL analysisStep emptyAnalysisState sorted
+ mapM_ printResult final
where
collectAndLog pb root =
collectGcroot root
<* ProgressBar.incProgress pb 1
+ sortRootKey root =
+ ( negate $ totalSize $ gcrootDependencies root
+ , gcrootPath root
+ )
+
findRoots :: FilePath -> IO [FilePath]
findRoots path = do
isLink <- pathIsSymbolicLink path
instance Exception PathInfoException
-printGcroot :: Gcroot -> IO ()
-printGcroot gcroot = do
- putStr (gcrootPath gcroot <> ": ")
- putStrLn $ formatFileSize $ totalSize (gcrootDependencies gcroot)
+printResult :: (Gcroot, AnalysisResult) -> IO ()
+printResult (gcroot, result) = do
+ printf "%7s %7s %s\n"
+ (formatFileSize $ resultTotalSize result)
+ (formatFileSize $ resultUnseenSize result)
+ (gcrootPath gcroot)
totalSize :: (Foldable f, Functor f) => f PathInfo -> Int
totalSize = sum . fmap pathInfoNarSize
| s >= 10*1024 = show (s `quotInt` 1024) ++ "kb"
| otherwise = show s ++ "b"
+data AnalysisState = AnalysisState
+ { analysisStateSeen :: Set Text
+ }
+
+emptyAnalysisState :: AnalysisState
+emptyAnalysisState =
+ AnalysisState mempty
+
+data AnalysisResult = AnalysisResult
+ { resultTotalSize :: Int
+ , resultUnseenSize :: Int
+ }
+
+analysisStep :: AnalysisState -> Gcroot -> (AnalysisState, (Gcroot, AnalysisResult))
+analysisStep (AnalysisState seen) root =
+ let
+ dependencies :: [PathInfo]
+ dependencies = gcrootDependencies root
+
+ unseenDependencies :: [PathInfo]
+ unseenDependencies =
+ filter (flip Set.notMember seen . pathInfoPath) dependencies
+ in
+ ( AnalysisState (seen <> Set.fromList (fmap pathInfoPath unseenDependencies))
+ , ( root
+ , AnalysisResult
+ { resultTotalSize = totalSize dependencies
+ , resultUnseenSize = totalSize unseenDependencies
+ }
+ )
+ )
+ where
+ toSeenEntry pathInfo =
+ (pathInfoPath pathInfo, pathInfoNarSize pathInfo)
+
data PathInfo = PathInfo
{ pathInfoNarSize :: Int
, pathInfoPath :: Text