summary history branches tags files
commit:31f4f20727b6e31268bb7274e843f12f392f040f
author:avh4
committer:avh4
date:Sun Jan 22 17:29:18 2023 -0800
parents:e92b13c1349bb73bd7042675e077a6783a8446fa
Show size of each gcroot that is not in any previous gcroot
diff --git a/sizer.hs b/sizer.hs
line changes: +53/-7
index ffc6ff2..0f2dcf2
--- a/sizer.hs
+++ b/sizer.hs
@@ -5,15 +5,18 @@ import Control.Exception (Exception, IOException, try, throwIO)
 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
@@ -21,13 +24,19 @@ 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
@@ -82,10 +91,12 @@ data PathInfoException =
 
 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
@@ -97,6 +108,41 @@ formatFileSize s
   | 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