summary history branches tags files
commit:1bdc3168f2d442a1c055f62ea146232731c109c3
author:avh4
committer:avh4
date:Sun Jan 22 17:36:59 2023 -0800
parents:31f4f20727b6e31268bb7274e843f12f392f040f
Remove common prefix from output
diff --git a/sizer.hs b/sizer.hs
line changes: +8/-3
index 0f2dcf2..6d3337f
--- a/sizer.hs
+++ b/sizer.hs
@@ -5,11 +5,13 @@ 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.List (stripPrefix)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import GHC.Base (quotInt)
-import Relude (catMaybes, foldMapM, sortWith, mapAccumL)
+import Relude (foldMapM, sortWith, mapAccumL)
 import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
 import System.IO (stderr, hPutStrLn)
 import System.Posix.Files qualified as Posix
@@ -18,9 +20,12 @@ import System.ProgressBar (hNewProgressBar)
 import System.ProgressBar qualified as ProgressBar
 import Text.Printf (printf)
 
+rootsBase :: FilePath
+rootsBase = "/nix/var/nix/gcroots"
+
 main :: IO ()
 main = do
-  gcrootPaths <- findRoots "/nix/var/nix/gcroots"
+  gcrootPaths <- findRoots rootsBase
   hPutStrLn stderr "Scanning gcroots..."
   pb <- hNewProgressBar stderr ProgressBar.defStyle 10 (ProgressBar.Progress 0 (length gcrootPaths) ())
   gcroots <- catMaybes <$> mapM (collectAndLog pb) gcrootPaths
@@ -83,7 +88,7 @@ collectGcroot gcroot = do
         Left err ->
           throwIO $ PathInfoException err
         Right pathInfos ->
-          return $ Just $ Gcroot gcroot pathInfos
+          return $ Just $ Gcroot (fromMaybe gcroot $ stripPrefix (rootsBase <> "/") gcroot) pathInfos
 
 data PathInfoException =
   PathInfoException String