{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+import Control.Exception (IOException, try)
import Data.Aeson qualified as Aeson
import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), (.:), (.=), object)
import Data.Aeson.Types (prependFailure, typeMismatch)
import Data.Text (Text)
import GHC.Base (quotInt)
+import Relude (foldMapM)
+import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
+import System.Posix.Files qualified as Posix
import System.Process.Typed (readProcess_, proc)
main :: IO ()
main = do
- let gcroot = "per-user/avh4/current-home"
- (json, _) <- readProcess_ $ proc "nix" [ "--extra-experimental-features", "nix-command"
- , "path-info"
- , "--recursive"
- , "--size"
- , "--json"
- , "/nix/var/nix/gcroots/" ++ gcroot
- ]
- let pathInfos = Aeson.eitherDecode json :: Either String [PathInfo]
- print $ fmap (formatFileSize. totalSize) pathInfos
- return ()
+ gcroots <- findRoots "/nix/var/nix/gcroots"
+ mapM_ collectAndPrintGcroot gcroots
+
+findRoots :: FilePath -> IO [FilePath]
+findRoots path = do
+ isLink <- pathIsSymbolicLink path
+ isDir <- doesDirectoryExist path
+ case (isLink, isDir) of
+ (True, _) -> return [ path ]
+ (False, True) -> do
+ all <- fmap ((path <> "/") <>) <$> listDirectory path
+ foldMapM findRoots all
+
+isBrokenLink :: FilePath -> IO Bool
+isBrokenLink path = do
+ isLink <- pathIsSymbolicLink path
+ if isLink
+ then do
+ status <- try @IOException $ Posix.getFileStatus path
+ case status of
+ Left _ -> return True
+ Right _ -> return False
+ else
+ return False
+
+collectAndPrintGcroot :: FilePath -> IO ()
+collectAndPrintGcroot gcroot = do
+ isBroken <- isBrokenLink gcroot
+ if isBroken
+ then
+ return ()
+ else do
+ (json, _) <- readProcess_ $ proc "nix" [ "--extra-experimental-features", "nix-command"
+ , "path-info"
+ , "--recursive"
+ , "--size"
+ , "--json"
+ , gcroot
+ ]
+ let pathInfos_ = Aeson.eitherDecode json :: Either String [PathInfo]
+ putStr (gcroot <> ": ")
+ case pathInfos_ of
+ Left err ->
+ putStrLn ("ERROR: " <> err)
+ Right pathInfos ->
+ putStrLn $ formatFileSize $ totalSize pathInfos
totalSize :: (Foldable f, Functor f) => f PathInfo -> Int
totalSize = sum . fmap pathInfoNarSize