packages feed

stack-clean-old 0.2.2 → 0.3

raw patch · 7 files changed

+175/−100 lines, 7 files

Files

ChangeLog.md view
@@ -1,5 +1,18 @@ # Revision history for stack-clean-old-work +## 0.3 (2021-01-08)+- drop subsubcommands to simplify UI+- default to project if there is a .stack-work/ dir, otherwise global ~/.stack+- rename commands:+  - remove-version -> remove+  - remove-earlier-minor -> keep-minor+  - remove-older -> purge-older+  - remove-work -> delete-work+- fix handling of partially installed ghc compiler temp dirs (#2)+- rename --dryrun to --dry-run (#1)+- drop --dir option+- delete-work: use --all to run from a non-project dir+ ## 0.2.2 (2002-12-31) - add 'project remove-work' to recursively remove .stack-work from projects
README.md view
@@ -1,93 +1,93 @@ # stack-clean-old  A small tool to clean away older Haskell [stack](https://docs.haskellstack.org)-snapshot builds and ghc versions, to recover diskspace.+snapshot builds and ghc versions to recover diskspace.  ## Usage ```-stack-clean-old [project|snapshots|ghc] [size|list|remove-version|remove-earlier-minor] [GHCVER]+stack-clean-old [size|list|remove|keep-minor] [(-p|--project) | (-g|--ghc)] [GHCVER] ```-These commands act respectively on:+Options: -- the current local **project**: `.stack-work/install/`-- the user's stack **snapshot** builds: `~/.stack/snapshots/`-- installed stack **ghc** compilers: `~/.stack/programs/`.+- `--project` (default in a stack project dir): act on `.stack-work/install/`+- `--global` (default outside a project dir): act on `~/.stack/snapshots/` and `~/.stack/programs/`  and the subcommands:  `size`:-    prints the total size of the above directory+    prints the total size of the above directories     (`size` does not take a GHCVER argument).  `list`:     shows the total size and number of snapshots per ghc version     (the GHCVER argument is optional). -`remove-version`:-    removes all snapshots for the specified ghc version-    (the GHCVER argument is required).+`remove`:+    removes for the specified ghc version (the GHCVER argument is required). -`remove-earlier-minor`:+`keep-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.+If you remove any needed snapshot builds for a version of ghc, then you would have to rebuild them again for any projects still using them, so removal should be used cautiously, but it can recover a lot of diskspace. -NBB: All the command support `--dryrun` (`-n`) so you can check the effect+NBB: All the command support `--dry-run` (`-n`) so you can check the effect of running them safely beforehand.  ### Example usage To remove project builds for ghc-8.2.2: ```-$ stack-clean-old project list+$ stack-clean-old 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+$ stack-clean-old remove -p 8.2.2 ``` -Remove all stack ghc-8.4 snapshot builds before 8.4.4:+Remove stack ghc-8.4 snapshot builds and compilers before 8.4.4: ```-$ stack-clean-old snapshots list 8.4+$ stack-clean-old list -g 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+$ stack-clean-old keep-minor -g 8.4.4+ghc-tinfo6-8.4.3 removed 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.+Incidently I build my projects across as many major Stackage LTS versions as possible (using my stack-all tool), 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+stack-clean-old purge-older ``` This command removes older stack builds from `.stack-work/install/`. By default it keeps 5 newest builds per ghc version.  The preservation/deletion is calculated and done per ghc version. -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`.+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 `purge-older`. -Also `stack-clean-old project remove-work` can be used to recursively remove-all `.stack-work/` dirs from a project to save space.+Also `stack-clean-old delete-work` can be used to recursively remove+_all_ `.stack-work/` dirs from a project to save space (seems same as `stack clean --full`).  ## Installation  Run `stack install` or `cabal install` +## Related+This tool complements [stack-all](https://hackage.haskell.org/package/stack-all)+which builds projects over LTS major versions and hence generates lot of stack builds.+ ## Contributing BSD license  Project: https://github.com/juhp/stack-clean-old  ## Warning disclaimer-Use at your own risk.--The author takes no responsibility for any loss or damaged caused by using-this tool.+Use at your own risk: the author takes no responsibility for any loss or damaged caused by using this tool, as also mentioned in LICENSE.  Bug reports, suggestions, and improvements are welcome.
src/GHC.hs view
@@ -42,12 +42,12 @@  ghcInstallVersion :: FilePath -> Version ghcInstallVersion =-  readVersion . takeWhileEnd (/= '-')+  readVersion . takeWhileEnd (/= '-') .  dropSuffix ".temp"  listGhcInstallation :: Maybe Version -> IO () listGhcInstallation mghcver = do   dirs <- getGhcInstallDirs mghcver-  mapM_ (putStrLn . showVersion . ghcInstallVersion) $ case mghcver of+  mapM_ putStrLn $ case mghcver of     Nothing -> dirs     Just ghcver -> filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcInstallVersion) dirs @@ -55,11 +55,10 @@ removeGhcVersionInstallation dryrun ghcver = do   installs <- getGhcInstallDirs (Just ghcver)   case installs of-    [] -> error' $ "stack ghc compiler version " ++ showVersion ghcver ++ " not found"+    [] -> putStrLn $ "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+      Remove.prompt dryrun ("all stack ghc " ++ showVersion ghcver ++ " installations: ")       mapM_ (doRemoveGhcVersion dryrun) gs       else error' "more than one match found!!" @@ -78,5 +77,5 @@ doRemoveGhcVersion :: Bool -> FilePath -> IO () doRemoveGhcVersion dryrun ghcinst = do   Remove.doRemoveDirectory dryrun ghcinst-  unless dryrun (Remove.removeFile (ghcinst <.> "installed"))-  putStrLn $ ghcinst ++ " removed"+  Remove.removeFile dryrun (ghcinst <.> "installed")+  putStrLn $ ghcinst ++ "compiler " ++ (if dryrun then "would be " else "") ++ "removed"
src/Main.hs view
@@ -1,67 +1,116 @@+{-# LANGUAGE CPP #-}+ module Main (main) where +#if !MIN_VERSION_simple_cmd_args(0,1,3)+import Control.Applicative ((<|>))+#endif import Data.Version.Extra import SimpleCmd import SimpleCmdArgs+import System.Directory import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)  import GHC import Paths_stack_clean_old (version) import Snapshots +data Mode = Default | Project | Snapshots | Compilers | GHC+ 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-    [ Subcommand "project" "Commands for project .stack-work builds" $-      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" $-        listGhcSnapshots . setStackWorkDir <$> dirOption <*> optional ghcVerArg-      , 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 "remove-work" "Remove .stack-work subdirs recursively" $-        removeStackWorks <$> dryrun <*> optional (strArg "PROJECTDIR")-      ]-    , Subcommand "snapshots" "Commands for ~/.stack/snapshots" $-      subcommands-      [ Subcommand "size" "Total size of all stack build snapshots" $-        sizeSnapshots <$> notHumanOpt-      , Subcommand "list" "List build snapshots per ghc version" $-        listGhcSnapshots setStackSnapshotsDir <$> optional ghcVerArg-      , Subcommand "remove-version" "Remove build snapshots for a ghc version" $-        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-      [ Subcommand "size" "Total size of installed stack ghc compilers" $-        sizeGhcInstalls <$> notHumanOpt-      , Subcommand "list" "List installed stack ghc compiler versions" $-        listGhcInstallation <$> optional ghcVerArg-      , Subcommand "remove-version" "Remove installation of a stack ghc compiler version" $-        removeGhcVersionInstallation <$> dryrun <*> ghcVerArg-      , Subcommand "remove-earlier-minor" "Remove installations of stack ghc previous minor versions" $-        removeGhcMinorInstallation <$> dryrun <*> optional ghcVerArg-      ]+    [ Subcommand "size" "Total size" $+      sizeCmd <$> modeOpt <*> notHumanOpt+    , Subcommand "list" "List sizes per ghc version" $+      listCmd <$> modeOpt <*> optional ghcVerArg+    , Subcommand "remove" "Remove for a ghc version" $+      removeCmd <$> dryrun <*> modeOpt <*> ghcVerArg+    , Subcommand "keep-minor" "Remove for previous ghc minor versions" $+      removeMinorsCmd <$> dryrun <*> modeOpt <*> optional ghcVerArg+    , Subcommand "purge-older" "Purge older builds in .stack-work/install" $+      cleanOldStackWork <$> dryrun <*> keepOption+    , Subcommand "delete-work" "Remove project's .stack-work subdirs recursively" $+      removeStackWorks <$> dryrun <*> switchWith 'a' "all" "Find all .stack-work/ subdirs, even if current directory not a stack project"     ]   where-    dryrun = switchWith 'n' "dryrun" "Show what would be done, without removing"+    modeOpt =+      flagWith' Project 'p' "project" "Act on current project's .stack-work/ [default in project dir]" <|>+      flagWith' GHC 'g' "global" "Act on both ~/.stack/{programs,snapshots}/ [default outside project dir]" <|>+      flagWith' Snapshots 's' "snapshots" "Act on ~/.stack/snapshots/" <|>+      flagWith Default Compilers 'c' "compilers" "Act on ~/.stack/programs/" +    dryrun = switchWith 'n' "dry-run" "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 = readVersion <$> strArg "GHCVER"      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"+++sizeCmd :: Mode -> Bool -> IO ()+sizeCmd mode notHuman =+  case mode of+    Project -> sizeStackWork notHuman+    Snapshots -> sizeSnapshots notHuman+    Compilers -> sizeGhcInstalls notHuman+    GHC -> do+          sizeCmd Compilers notHuman+          sizeCmd Snapshots notHuman+    Default -> do+      isProject <- doesDirectoryExist ".stack-work"+      if isProject+        then sizeCmd Project notHuman+        else sizeCmd GHC notHuman++listCmd :: Mode -> Maybe Version -> IO ()+listCmd mode mver =+  case mode of+    Project -> listGhcSnapshots setStackWorkDir mver+    Snapshots -> listGhcSnapshots setStackSnapshotsDir mver+    Compilers -> listGhcInstallation mver+    GHC -> do+      listCmd Compilers mver+      listCmd Snapshots mver+    Default -> do+      isProject <- doesDirectoryExist ".stack-work"+      if isProject+        then listCmd Project mver+        else listCmd GHC mver++removeCmd :: Bool -> Mode -> Version -> IO ()+removeCmd dryrun mode ghcver =+  case mode of+    Project -> cleanGhcSnapshots setStackWorkDir dryrun ghcver+    Snapshots -> cleanGhcSnapshots setStackSnapshotsDir dryrun ghcver+    Compilers -> removeGhcVersionInstallation dryrun ghcver+    GHC -> do+      removeCmd dryrun Compilers ghcver+      removeCmd dryrun Snapshots ghcver+    Default -> do+      isProject <- doesDirectoryExist ".stack-work"+      if isProject+        then removeCmd dryrun Project ghcver+        else removeCmd dryrun GHC ghcver++removeMinorsCmd :: Bool -> Mode -> Maybe Version -> IO ()+removeMinorsCmd dryrun mode mver =+  case mode of+    Project -> cleanMinorSnapshots setStackWorkDir dryrun mver+    Snapshots -> cleanMinorSnapshots setStackSnapshotsDir dryrun mver+    Compilers -> removeGhcMinorInstallation dryrun mver+    GHC -> do+      removeMinorsCmd dryrun Compilers mver+      removeMinorsCmd dryrun Snapshots mver+    Default -> do+      isProject <- doesDirectoryExist ".stack-work"+      if isProject+        then removeMinorsCmd dryrun Project mver+        else removeMinorsCmd dryrun GHC mver
src/Remove.hs view
@@ -1,13 +1,26 @@ module Remove (   doRemoveDirectory,+  prompt,   removeFile   ) where -import Control.Monad-import System.Directory+import Control.Monad.Extra+import qualified System.Directory as D  doRemoveDirectory :: Bool -> FilePath -> IO () doRemoveDirectory dryrun dir =   unless dryrun $-  removeDirectoryRecursive dir+  D.removeDirectoryRecursive dir++removeFile :: Bool -> FilePath -> IO ()+removeFile dryrun file =+  unless dryrun $+  whenM (D.doesFileExist file) $+  D.removeFile file++prompt :: Bool -> String -> IO ()+prompt dryrun str =+  unless dryrun $ do+  putStr $ "Press Enter to delete " ++ str ++ ": "+  void getLine
src/Snapshots.hs view
@@ -17,7 +17,6 @@  import Control.Monad.Extra import Data.List.Extra-import Data.Maybe import Data.Version.Extra import SimpleCmd #if MIN_VERSION_simple_cmd(0,2,1)@@ -90,15 +89,14 @@ removeVersionSnaps dryrun versnap = do   let dirs = snapsHashes versnap   mapM_ (Remove.doRemoveDirectory dryrun) dirs-  putStrLn $ show (length dirs) ++ " snapshots removed for " ++ showVersion (snapsVersion versnap)+  putStrLn $ show (length dirs) ++ " dirs in ~/.stack/snapshots/ " ++ (if dryrun then "would be " else "") ++ "removed for " ++ showVersion (snapsVersion versnap)  cleanGhcSnapshots :: IO () -> Bool -> Version -> IO () cleanGhcSnapshots setDir dryrun ghcver = do   setDir   ghcs <- getSnapshotDirs (Just ghcver)   when (isMajorVersion ghcver) $ do-    putStr $ "Press Enter to delete all " ++ showVersion ghcver ++ " builds: "-    void getLine+    Remove.prompt dryrun ("all " ++ showVersion ghcver ++ " builds")   mapM_ (removeVersionSnaps dryrun) ghcs  cleanMinorSnapshots :: IO () -> Bool -> Maybe Version -> IO ()@@ -118,9 +116,9 @@           gminors = filter ((< newestMinor) . snapsVersion) ghcs       mapM_ (removeVersionSnaps dryrun) gminors -cleanOldStackWork :: Bool -> Int -> Maybe FilePath -> IO ()-cleanOldStackWork dryrun keep mdir = do-  setStackWorkDir mdir+cleanOldStackWork :: Bool -> Int -> IO ()+cleanOldStackWork dryrun keep = do+  setStackWorkDir   dirs <- sortOn takeFileName . lines <$> shell ( unwords $ "ls" : ["-d", "*/*"])   let ghcs = groupOn takeFileName dirs   mapM_ removeOlder ghcs@@ -146,9 +144,9 @@ stackWorkInstall :: FilePath stackWorkInstall = ".stack-work/install" -sizeStackWork :: Maybe FilePath -> Bool -> IO ()-sizeStackWork mdir nothuman = do-  let path = fromMaybe "" mdir </> stackWorkInstall+sizeStackWork :: Bool -> IO ()+sizeStackWork nothuman = do+  let path = stackWorkInstall   whenM (doesDirectoryExist path) $     cmd_ "du" $ ["-h" | not nothuman] ++ ["-s", path] @@ -157,21 +155,23 @@   total <- head . words . last <$> cmdLines "du" ("-shc":snapsHashes versnaps)   printf "%4s  %-6s (%d dirs)\n" total ((showVersion . snapsVersion) versnaps) (length (snapsHashes versnaps)) -setStackWorkDir :: Maybe FilePath -> IO ()-setStackWorkDir mdir = do-  whenJust mdir setCurrentDirectory+setStackWorkDir :: IO ()+setStackWorkDir = do   switchToSystemDirUnder stackWorkInstall  setStackSnapshotsDir :: IO () setStackSnapshotsDir = do   getStackSubdir "snapshots" >>= switchToSystemDirUnder -removeStackWorks :: Bool -> Maybe FilePath -> IO ()-removeStackWorks dryrun mdir = do-  whenJust mdir setCurrentDirectory-  workdirs <- sort <$> cmdLines "find" ["-type", "d", "-name", ".stack-work"]-  unless (null workdirs) $ do-    mapM_ putStrLn workdirs-    putStr "Press Enter to delete these dirs: "-    void getLine-    mapM_ (Remove.doRemoveDirectory dryrun) workdirs+removeStackWorks :: Bool -> Bool -> IO ()+removeStackWorks dryrun allrecurse = do+  recurse <-+    if allrecurse then return True+    else doesDirectoryExist ".stack-work"+  if recurse then do+    workdirs <- sort <$> cmdLines "find" ["-type", "d", "-name", ".stack-work"]+    unless (null workdirs) $ do+      mapM_ putStrLn workdirs+      Remove.prompt dryrun "these dirs"+      mapM_ (Remove.doRemoveDirectory dryrun) workdirs+    else error' "run in a project dir (containing .stack-work/)\n or use --all to find and remove all .stack-work/ subdirectories"
stack-clean-old.cabal view
@@ -1,8 +1,9 @@ name:                stack-clean-old-version:             0.2.2+version:             0.3 synopsis:            Clean away old stack build artefacts description:-        A tool for cleaning away old .stack snapshots and .stack-work builds+        A tool for removing old .stack-work/install builds and+        .stack/snapshots & programs for older ghc versions         to recover diskspace. license:             BSD3 license-file:        LICENSE