etc/diskspace: extend to also clean unpacked .stack-work builds

[skip ci]
This commit is contained in:
Jens Petersen 2023-06-17 23:55:30 +02:00
parent 67a7f60e6c
commit 04ee14c769

View File

@ -3,19 +3,36 @@
-- Utility to remove old libs installed under .stack-work/ to save diskspace
-- Should be run in:
-- work/*/unpack-dir/.stack-work/install/x86_64-linux/*/*/lib/x86_64-linux-ghc-*
import Control.Monad
import Data.List
import System.Directory
import System.FilePath
import System.Environment
import Text.Regex.TDFA
-- keep 2 latest builds
keepBuilds :: Int
keepBuilds = 2
main :: IO ()
main = do
args <- getArgs
case args of
[stream] -> do
home <- getHomeDirectory
withCurrentDirectory (home </> "stackage/automated/work" </> stream </> "unpack-dir") $ do
cleanStackWorkInstall
cleanStackWorkPackages
_ -> error "arg should be 'lts' or 'nightly'"
-- navigates to: .stack-work/install/x86_64-linux*/*/*/lib/x86_64-linux-ghc-*
cleanStackWorkInstall :: IO ()
cleanStackWorkInstall =
withCurrentDirectory ".stack-work/install"
$ withOneDirectory_ -- "x86_64-linux*"
$ withOneDirectory_ -- hash
$ withOneDirectory $ \ghcver ->
withCurrentDirectory ("lib" </> "x86_64-linux-ghc-" ++ ghcver) $ do
files <- sort <$> listDirectory "."
let (dynlibs,libdirs) = partition (".so" `isExtensionOf`) files
pkglibdirs = groupBy samePkgLibDir libdirs
@ -45,13 +62,41 @@ main = do
removeDashSegment = dropWhileEnd (/= '-')
removeOlder remover files = do
oldfiles <- drop keepBuilds . reverse <$> sortByAge files
mapM_ remover oldfiles
removeOlder remover files = do
oldfiles <- drop keepBuilds . reverse <$> sortByAge files
mapM_ remover oldfiles
where
sortByAge files = do
timestamps <- mapM getModificationTime files
let fileTimes = zip files timestamps
return $ map fst $ sortBy compareSnd fileTimes
compareSnd (_,t1) (_,t2) = compare t1 t2
-- navigates to:
-- unpacked/*/.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.8.1.0/build/
cleanStackWorkPackages :: IO ()
cleanStackWorkPackages =
withCurrentDirectory "unpacked" $ do
pkgs <- listDirectory "."
forM_ pkgs $ \pkg -> do
withCurrentDirectory ".stack-work/dist/x86_64-linux-tinfo6"
$ withOneDirectory_ -- "Cabal-3.8.1.0"
$ withCurrentDirectory "build" $ do
ls <- sort <$> listDirectory "."
files <- filterM doesFileExist ls
let (dynlibs,statlibs) = partition (".so" `isExtensionOf`) files
removeOlder removeFile dynlibs
removeOlder removeFile statlibs
withOneDirectory_ act = do
ls <- listDirectory "."
case ls of
[l] -> withCurrentDirectory l act
_ -> error $ "more than one directory found: " ++ unwords ls
withOneDirectory act = do
ls <- listDirectory "."
case ls of
[l] -> withCurrentDirectory l $ act l
_ -> error $ "more than one directory found: " ++ unwords ls