stack-clean-old 0.1 → 0.2
raw patch · 4 files changed
+169/−42 lines, 4 filesdep ~directorydep ~extra
Dependency ranges changed: directory, extra
Files
- ChangeLog.md +7/−1
- Main.hs +119/−31
- README.md +39/−6
- stack-clean-old.cabal +4/−4
ChangeLog.md view
@@ -1,4 +1,10 @@ # Revision history for stack-clean-old-work -## 0.1 (2020-09-xx)+## 0.2 (2020-10-26)+- add --dryrun to all remove commands+- remove-earlier-minor subcommands to purge for previous ghc minor versions+- allow major ghc X.Y versions (prompts for removal)+- 'ghc list' is now sorted++## 0.1 (2020-09-22) - initial release with project and snapshots subcommands
Main.hs view
@@ -11,12 +11,14 @@ import SimpleCmdArgs import System.Directory import System.FilePath+import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import Text.Printf import Paths_stack_clean_old (version) main :: IO () main = do+ hSetBuffering stdout NoBuffering simpleCmdArgs (Just version) "Stack clean up tool" "Cleans away old stack-work builds (and pending: stack snapshots) to recover diskspace." $ subcommands@@ -24,12 +26,14 @@ subcommands [ Subcommand "size" "Total size of project's .stack-work/install" $ sizeStackWork <$> dirOption <*> notHumanOpt- , Subcommand "list" "list builds in .stack-work/install per ghc version" $+ , Subcommand "list" "List builds in .stack-work/install per ghc version" $ listGhcSnapshots . setStackWorkDir <$> dirOption <*> optional ghcVerArg- , Subcommand "remove-version" "remove builds in .stack-work/install for a ghc version" $- cleanGhcSnapshots . setStackWorkDir <$> dirOption <*> ghcVerArg- , Subcommand "remove-older" "purge older builds in .stack-work/install" $- cleanOldStackWork <$> keepOption <*> optional (strArg "PROJECTDIR")+ , Subcommand "remove-version" "Remove builds in .stack-work/install for a ghc version" $+ cleanGhcSnapshots . setStackWorkDir <$> dirOption <*> dryrun <*> ghcVerArg+ , Subcommand "remove-earlier-minor" "Remove builds in .stack-work/install for previous ghc minor versions" $+ cleanMinorSnapshots . setStackWorkDir <$> dirOption <*> dryrun <*> optional ghcVerArg+ , Subcommand "remove-older" "Purge older builds in .stack-work/install" $+ cleanOldStackWork <$> dryrun <*> keepOption <*> optional (strArg "PROJECTDIR") ] , Subcommand "snapshots" "Commands for ~/.stack/snapshots" $ subcommands@@ -38,7 +42,9 @@ , Subcommand "list" "List build snapshots per ghc version" $ listGhcSnapshots setStackSnapshotsDir <$> optional ghcVerArg , Subcommand "remove-version" "Remove build snapshots for a ghc version" $- cleanGhcSnapshots setStackSnapshotsDir <$> ghcVerArg+ cleanGhcSnapshots setStackSnapshotsDir <$> dryrun <*> ghcVerArg+ , Subcommand "remove-earlier-minor" "Remove build snapshots for previous ghc minor versions" $+ cleanMinorSnapshots setStackSnapshotsDir <$> dryrun <*> optional ghcVerArg ] , Subcommand "ghc" "Commands on stack's ghc compiler installations" $ subcommands@@ -47,17 +53,20 @@ , Subcommand "list" "List installed stack ghc compiler versions" $ listGhcInstallation <$> optional ghcVerArg , Subcommand "remove-version" "Remove installation of a stack ghc compiler version" $- removeGhcVersionInstallation <$> ghcVerArg+ removeGhcVersionInstallation <$> dryrun <*> ghcVerArg+ , Subcommand "remove-earlier-minor" "Remove installations of stack ghc previous minor versions" $+ removeGhcMinorInstallation <$> dryrun <*> optional ghcVerArg ]- ] where+ dryrun = switchWith 'n' "dryrun" "Show what would be done, without removing"+ notHumanOpt = switchWith 'H' "not-human-size" "Do not use du --human-readable" dirOption = optional (strOptionWith 'd' "dir" "PROJECTDIR" "Path to project")- ghcVerArg = strArg "GHCVER"+ ghcVerArg = readVersion <$> strArg "GHCVER" - keepOption = positive <$> optionalWith auto 'k' "keep" "INT" "number of project builds per ghc version" 5+ keepOption = positive <$> optionalWith auto 'k' "keep" "INT" "number of project builds per ghc version [default 5]" 5 positive :: Int -> Int positive n = if n > 0 then n else error' "Must be positive integer"@@ -90,16 +99,16 @@ getSnapshotDirs = do lines <$> shell ( unwords $ "ls" : ["-d", "*/*"]) -takeGhcSnapshots :: String -> [FilePath] -> [FilePath]+takeGhcSnapshots :: Version -> [FilePath] -> [FilePath] takeGhcSnapshots ghcver =- map takeDirectory . filter ((== ghcver) . takeFileName)+ map takeDirectory . filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . readVersion . takeFileName) sizeSnapshots :: Bool -> IO () sizeSnapshots nothuman = do home <- getHomeDirectory cmd_ "du" $ ["-h" | not nothuman] ++ ["-s", home </> ".stack/snapshots"] -listGhcSnapshots :: IO () -> Maybe String -> IO ()+listGhcSnapshots :: IO () -> Maybe Version -> IO () listGhcSnapshots setdir mghcver = do setdir dirs <- sortOn (readVersion . takeFileName) <$> getSnapshotDirs@@ -107,18 +116,67 @@ Nothing -> do let ghcs = groupOn takeFileName dirs mapM_ printTotalGhcSize ghcs+ Just ghcver | isMajorVersion ghcver -> do+ let ghcs = groupOn takeFileName $ filter ((== ghcver) . majorVersion . readVersion . takeFileName) dirs+ mapM_ printTotalGhcSize ghcs Just ghcver -> do let ds = takeGhcSnapshots ghcver dirs- unless (null dirs) $+ unless (null ds) $ cmd_ "du" ("-shc":ds) -cleanGhcSnapshots :: IO () -> String -> IO ()-cleanGhcSnapshots setDir ghcver = do+doRemoveDirectory :: Bool -> FilePath -> IO ()+doRemoveDirectory dryrun dir =+ unless dryrun $+ removeDirectoryRecursive dir++cleanGhcSnapshots :: IO () -> Bool -> Version -> IO ()+cleanGhcSnapshots setDir dryrun ghcver = do setDir dirs <- takeGhcSnapshots ghcver <$> getSnapshotDirs- mapM_ removeDirectoryRecursive dirs- putStrLn $ show (length dirs) ++ " snapshots removed for " ++ ghcver+ unless (dryrun || null dirs) $+ when (isMajorVersion ghcver) $ do+ putStr $ "Press Enter to delete all " ++ showVersion ghcver ++ " builds: "+ void getLine+ unless (null dirs) $ do+ mapM_ (doRemoveDirectory dryrun) dirs+ putStrLn $ show (length dirs) ++ " snapshots removed for " ++ showVersion ghcver +cleanMinorSnapshots :: IO () -> Bool -> Maybe Version -> IO ()+cleanMinorSnapshots setDir dryrun mghcver = do+ setDir+ dirs <- sortOn (readVersion . takeFileName) <$> getSnapshotDirs+ case mghcver of+ Nothing -> do+ let ghcs = map (groupOn takeFileName) $ groupOn (majorVersion . readVersion) dirs+ forM_ ghcs $ \ gmajor ->+ when (length gmajor > 1) $+ forM_ (init gmajor) $ \ gminor -> do+ mapM_ (doRemoveDirectory dryrun) gminor+ putStrLn $ show (length gminor) ++ " snapshots removed for " ++ takeFileName (head gminor)+ Just ghcver -> do+ let major =+ if length (versionBranch ghcver) == 2+ then majorVersion ghcver+ else error' "Please specify minor version X.Y.Z"+ gmajor = groupOn takeFileName $ filter (olderMinor major ghcver) dirs+ when (length gmajor > 1) $+ forM_ (init gmajor) $ \ gminor -> do+ mapM_ (doRemoveDirectory dryrun) gminor+ putStrLn $ show (length gminor) ++ " snapshots removed for " ++ takeFileName (head gminor)+ where+ olderMinor :: Version -> Version -> FilePath -> Bool+ olderMinor major ghcver d =+ ((== major) . majorVersion . readVersion) d &&+ ((< ghcver) . readVersion . takeFileName) d++majorVersion :: Version -> Version+majorVersion ver =+ let vernums = versionBranch ver in+ case length vernums of+ 2 -> ver+ 3 -> (makeVersion . init) vernums+ _ -> error' $ "Bad ghc version " ++ showVersion ver+ switchToSystemDirUnder :: FilePath -> IO () switchToSystemDirUnder dir = do ifM (doesDirectoryExist dir)@@ -131,8 +189,8 @@ _ -> error' "More than one OS systems found " ++ dir ++ " (unsupported)" setCurrentDirectory system -cleanOldStackWork :: Int -> Maybe FilePath -> IO ()-cleanOldStackWork keep mdir = do+cleanOldStackWork :: Bool -> Int -> Maybe FilePath -> IO ()+cleanOldStackWork dryrun keep mdir = do setStackWorkDir mdir dirs <- sortOn takeFileName . lines <$> shell ( unwords $ "ls" : ["-d", "*/*"]) let ghcs = groupOn takeFileName dirs@@ -142,7 +200,7 @@ removeOlder dirs = do let ghcver = (takeFileName . head) dirs oldfiles <- drop keep . reverse <$> sortedByAge- mapM_ (removeDirectoryRecursive . takeDirectory) oldfiles+ mapM_ (doRemoveDirectory dryrun . takeDirectory) oldfiles unless (null oldfiles) $ putStrLn $ show (length oldfiles) ++ " dirs removed for " ++ ghcver where@@ -174,17 +232,47 @@ setStackProgramsDir listDirectory "." >>= fmap sort . filterM doesDirectoryExist -listGhcInstallation :: Maybe String -> IO ()+ghcInstallVersion :: FilePath -> Version+ghcInstallVersion =+ readVersion . takeWhileEnd (/= '-')++isMajorVersion :: Version -> Bool+isMajorVersion ver =+ majorVersion ver == ver++listGhcInstallation :: Maybe Version -> IO () listGhcInstallation mghcver = do- dirs <- getGhcInstallDirs+ dirs <- sortOn ghcInstallVersion <$> getGhcInstallDirs mapM_ putStrLn $ case mghcver of Nothing -> dirs- Just ghcver -> filter (ghcver `isSuffixOf`) dirs+ Just ghcver -> filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcInstallVersion) dirs -removeGhcVersionInstallation :: String -> IO ()-removeGhcVersionInstallation ghcver = do- dirs <- getGhcInstallDirs- case filter (ghcver `isSuffixOf`) dirs of- [] -> error' $ "stack ghc compiler version " ++ ghcver ++ " not found"- [g] -> removeDirectoryRecursive g >> removeFile (g <.> "installed")- _ -> error' "more than one match found!!"+removeGhcVersionInstallation :: Bool -> Version -> IO ()+removeGhcVersionInstallation dryrun ghcver = do+ installs <- filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcInstallVersion) <$> getGhcInstallDirs+ case installs of+ [] -> error' $ "stack ghc compiler version " ++ showVersion ghcver ++ " not found"+ [g] | not (isMajorVersion ghcver) -> doRemoveGhcVersion dryrun g+ gs -> if isMajorVersion ghcver then do+ putStr $ "Press Enter to delete all stack " ++ showVersion ghcver ++ " installations: "+ void getLine+ mapM_ (doRemoveGhcVersion dryrun) gs+ else error' "more than one match found!!"++removeGhcMinorInstallation :: Bool -> Maybe Version -> IO ()+removeGhcMinorInstallation dryrun mghcver = do+ dirs <- sortOn ghcInstallVersion <$> getGhcInstallDirs+ case mghcver of+ Nothing -> do+ let majors = groupOn (majorVersion . ghcInstallVersion) dirs+ forM_ majors $ \ minors ->+ forM_ (init minors) $ doRemoveGhcVersion dryrun+ Just ghcver -> do+ let minors = filter ((== majorVersion ghcver) . majorVersion . readVersion) dirs+ forM_ (init minors) $ doRemoveGhcVersion dryrun++doRemoveGhcVersion :: Bool -> FilePath -> IO ()+doRemoveGhcVersion dryrun ghcinst = do+ doRemoveDirectory dryrun ghcinst+ unless dryrun (removeFile (ghcinst <.> "installed"))+ putStrLn $ ghcinst ++ " removed"
README.md view
@@ -5,14 +5,16 @@ ## Usage ```-stack-clean-old [project|snapshots|ghc] [size|list|remove-version] [GHCVER]+stack-clean-old [project|snapshots|ghc] [size|list|remove-version|remove-earlier-minor] [GHCVER] ``` These commands act respectively on: -- the current local project (`.stack-work/install/`)-- the user's stack snapshot builds (`~/.stack/snapshots/`)-- installed stack ghc compilers (`~/.stack/programs/`).+- the current local **project**: `.stack-work/install/`+- the user's stack **snapshot** builds: `~/.stack/snapshots/`+- installed stack **ghc** compilers: `~/.stack/programs/`. +and the subcommands:+ `size`: prints the total size of the above directory (`size` does not take a GHCVER argument).@@ -25,8 +27,37 @@ removes all snapshots for the specified ghc version (the GHCVER argument is required). +`remove-earlier-minor`:+ removes the builds/installs for previous minor ghc versions.+ If GHCVER is given then only minor versions older than it are removed.+ NB: If you remove all snapshot builds for a version of ghc, then you would have to rebuild again for any projects still using them, so removal should be used cautiously, but it can recover a lot of diskspace. +### Example usage+To remove project builds for ghc-8.2.2:+```+$ stack-clean-old project list+154M 8.2.2 (5 dirs)+154M 8.4.4 (5 dirs)+163M 8.6.5 (5 dirs)+$ stack-clean-old project remove-version 8.2.2+```++Remove all stack ghc-8.4 snapshot builds before 8.4.4:+```+$ stack-clean-old snapshots list 8.4+421M 8.4.1 (7 dirs)+368M 8.4.2 (6 dirs)+489M 8.4.3 (8 dirs)+799M 8.4.4 (24 dirs)+$ stack-clean-old snapshots remove-earlier-minor 8.4.4+7 dirs removed for 8.4.1+6 dirs removed for 8.4.2+8 dirs removed for 8.4.3+```++Incidently I build my projects across as many major Stackage LTS versions as possible, and collectively this piles up to a lot of diskspace: so I wrote this tool to help manage that.+ ### Purging older stack project builds ``` stack-clean-old project remove-older@@ -36,7 +67,7 @@ The preservation/deletion is calculated and done per ghc version. -NB: If you regularly build multiple branches/tags against the same LTS or ghc version then it is probably safer to avoid using `remove-older`.+NB: If you regularly build your project for several branches/tags against the same LTS or ghc version then it is safer to avoid using `remove-older`. ## Installation @@ -51,4 +82,6 @@ Use at your own risk. The author takes no responsibility for any loss or damaged caused by using-this tool. Bug reports, suggestions, and improvements are welcome.+this tool.++Bug reports, suggestions, and improvements are welcome.
stack-clean-old.cabal view
@@ -1,8 +1,8 @@ name: stack-clean-old-version: 0.1+version: 0.2 synopsis: Clean away old stack build artefacts description:- A tool for cleaning away old stack snapshots and stack-work builds+ A tool for cleaning away old .stack snapshots and .stack-work builds to recover diskspace. license: BSD3 license-file: LICENSE@@ -26,8 +26,8 @@ other-modules: Paths_stack_clean_old -- hs-source-dirs: app build-depends: base < 5- , directory- , extra+ , directory >= 1.2.5+ , extra >= 1.4.3 , filepath , simple-cmd >= 0.1.4 , simple-cmd-args >= 0.1.2