packages feed

stack-clean-old 0.4.3 → 0.4.4

raw patch · 5 files changed

+112/−101 lines, 5 files

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ # Release history for stack-clean-old-work +## 0.4.4 (2022-01-04)+- handle .stack-work/ consistently for --subdir and --recursive+- remind user to use '--delete' for removal+- purge-older: output is now sorted by ghc versions+ ## 0.4.3 (2021-11-23) - 'delete-work' now prints ".stack-work" would be deleted - prompts now print what would be deleted
README.md view
@@ -4,18 +4,15 @@ snapshot builds and ghc versions to recover diskspace.  ## Usage-`stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [-d|--delete] [(-p|--project) | (-g|--ghc)] [GHCVER]-`--Options:+`stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-P|--project)|(-G|--global)] [(-s|--subdirs)|(-r|--recursive)] [-d|--delete] [GHCVER]` -- `--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/`+In a project directory it acts on `.stack-work/install/` by default,+otherwise on `~/.stack/{snapshots,programs}/`. -and the subcommands:+Subcommands:  `size`:-    prints the total size of the above directories+    prints the total size of `.stack-work/` or `~/.stack/`     (`size` does not take a GHCVER argument).  `list`:@@ -27,19 +24,25 @@  `keep-minor`:     removes the builds/installs for older minor releases of ghc major versions.-    If GHCVER is given then only minor versions older than it are removed.+    If GHCVER is given then only minor versions older than it+    (or than the latest installed minor version) are removed.+    If no GHCVER is given it applies to each installed ghc major version. -`purge-older` and `delete-work`:-    see sections below+`purge-older`:+    removes snapshot builds with older timestamps -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.+`delete-work`:+    removes `.stack-work` directories completely  Since version 0.4 dry-run mode is now the default and one needs to use `--delete` (`-d`) for actual deletion of files, after checking the dry-run output first. +If you should remove any needed snapshot builds,+then they will get rebuilt again by stack next time you build any projects+using them, so removals should be done carefully+but can recover a lot of diskspace.+ ### Example usage List a project's builds: ```ShellSession@@ -55,7 +58,7 @@ ``` (--project is optional in a project dir). -Remove stack ghc-8.4 snapshot builds and compilers before 8.4.4:+Remove stack ghc-8.4 snapshot builds and minor compilers before 8.4.4: ```ShellSession $ stack-clean-old list --global 8.4 421M  8.4.1  (7 dirs)@@ -83,18 +86,16 @@  ### Deleting all `.stack-work/` subdirectories `stack-clean-old delete-work --recursive` can be used to remove recursively-_all_ `.stack-work/` dirs from a project to save space-(seems same as `stack clean --full`).--`stack-clean-old delete-work --all` works from outside stack projects:-please use with care with `--delete`.+_all_ `.stack-work/` dirs within (or outside) a project directory to save+space (seems same as `stack clean --full` inside a project).  ### Help output (Note you can also run this tool via `stack clean-old`.)  To get help you can run `stack-clean-old --help` or just: ```ShellSession-$ Stack clean up tool+$ stack-clean-old+Stack clean up tool  Usage: stack-clean-old [--version] COMMAND   Cleans away old stack-work builds (and pending: stack snapshots) to recover@@ -120,7 +121,8 @@ Run `stack install` or `cabal install`  ## Related-This tool complements [stack-all](https://hackage.haskell.org/package/stack-all)+This tool complements+[stack-all](https://hackage.haskell.org/package/stack-all) which builds projects across LTS major versions and hence generates a lot of stack builds. @@ -130,7 +132,7 @@ ## Contributing BSD license -Project: https://github.com/juhp/stack-clean-old+Project: <https://github.com/juhp/stack-clean-old>  ## Disclaimer Use at your own risk: the author takes no responsibility for any loss or
src/Main.hs view
@@ -94,51 +94,47 @@     systemOpt = strOptionWith 'o' "os-system" "SYSTEM"                 "Specify which of the OS platforms to work on (eg 'x86_64-linux-tinfo6' or 'aarch64-linux-nix', etc)" -withRecursion :: Maybe Recursion -> IO () -> IO ()-withRecursion mrecursion act = do-  case mrecursion of-    Just recursion -> do-      dirs <- if recursion == Recursive-              then map takeDirectory <$> findStackWorks-              else listStackSubdirs-      forM_ dirs $ \dir ->-        withCurrentDirectory dir $ do-        putStrLn $ "\n" ++ takeFileName dir ++ "/"-        act-    Nothing -> act+withRecursion :: Bool -> Maybe Recursion -> IO () -> IO ()+withRecursion needinstall mrecursion =+  withRecursion' True needinstall mrecursion . const -withRecursion' :: Maybe Recursion -> (FilePath -> IO ()) -> IO ()-withRecursion' mrecursion act = do+withRecursion' :: Bool -> Bool -> Maybe Recursion -> (FilePath -> IO ()) -> IO ()+withRecursion' changedir needinstall mrecursion act = do   case mrecursion of     Just recursion -> do-      dirs <- if recursion == Recursive-              then map (dropPrefix "./" . takeDirectory) <$> findStackWorks-              else listStackSubdirs-      mapM_ act dirs+      dirs <- (if recursion == Recursive+               then map (dropPrefix "./" . takeDirectory) <$> findStackWorks+               else listStackSubdirs)+              >>= if needinstall+                  then filterM (doesDirectoryExist . (</> "install"))+                  else return+      forM_ dirs $ \dir ->+        if changedir+        then+          withCurrentDirectory dir $ do+          putStrLn $ "\n" ++ takeFileName dir ++ "/"+          act dir+        else act dir     Nothing -> act ""  sizeCmd :: Mode -> Maybe Recursion -> Bool -> IO () sizeCmd mode mrecursion notHuman =-  withRecursion' mrecursion $ \dir ->   case mode of-    Project -> sizeStackWork notHuman dir+    Project -> withRecursion' False False mrecursion $ sizeStackWork notHuman     Snapshots -> sizeSnapshots notHuman     Compilers -> sizeGhcInstalls notHuman     GHC -> do       sizeCmd Snapshots Nothing notHuman       sizeCmd Compilers Nothing notHuman-    Default ->-      if isJust mrecursion-      then sizeStackWork notHuman dir-      else do+    Default -> do       isProject <- doesDirectoryExist ".stack-work"-      if isProject-        then sizeCmd Project Nothing notHuman+      if isProject || isJust mrecursion+        then sizeCmd Project mrecursion notHuman         else sizeCmd GHC Nothing notHuman  listCmd :: Mode -> Maybe Recursion -> Maybe Version -> Maybe String -> IO () listCmd mode mrecursion mver msystem =-  withRecursion mrecursion $+  withRecursion True mrecursion $   case mode of     Project -> setStackWorkInstallDir msystem >> listGhcSnapshots mver     Snapshots -> setStackSnapshotsDir msystem >> listGhcSnapshots mver@@ -154,66 +150,73 @@  removeCmd :: Deletion -> Mode -> Maybe Recursion -> Version -> Maybe String           -> IO ()-removeCmd deletion mode mrecursion ghcver msystem =-  withRecursion mrecursion $-  case mode of-    Project -> do-      cwd <- getCurrentDirectory-      setStackWorkInstallDir msystem-      cleanGhcSnapshots deletion cwd ghcver-    Snapshots -> do-      cwd <- getCurrentDirectory-      setStackSnapshotsDir msystem-      cleanGhcSnapshots deletion cwd ghcver-    Compilers -> removeGhcVersionInstallation deletion ghcver msystem-    GHC -> do-      removeCmd deletion Compilers Nothing ghcver msystem-      removeCmd deletion Snapshots Nothing ghcver msystem-    Default -> do-      isProject <- doesDirectoryExist ".stack-work"-      if isProject-        then removeCmd deletion Project Nothing ghcver msystem-        else removeCmd deletion GHC Nothing ghcver msystem+removeCmd deletion mode mrecursion ghcver msystem = do+  withRecursion True mrecursion $+    case mode of+      Project -> do+        cwd <- getCurrentDirectory+        setStackWorkInstallDir msystem+        cleanGhcSnapshots deletion cwd ghcver+      Snapshots -> do+        cwd <- getCurrentDirectory+        setStackSnapshotsDir msystem+        cleanGhcSnapshots deletion cwd ghcver+      Compilers -> removeGhcVersionInstallation deletion ghcver msystem+      GHC -> do+        removeCmd deletion Compilers Nothing ghcver msystem+        removeCmd deletion Snapshots Nothing ghcver msystem+      Default -> do+        isProject <- doesDirectoryExist ".stack-work"+        if isProject+          then removeCmd deletion Project Nothing ghcver msystem+          else removeCmd deletion GHC Nothing ghcver msystem+  remindDelete deletion  removeMinorsCmd :: Deletion -> Mode -> Maybe Recursion -> Maybe Version                 -> Maybe String -> IO ()-removeMinorsCmd deletion mode mrecursion mver msystem =-  withRecursion mrecursion $-  case mode of-    Project -> do-      cwd <- getCurrentDirectory-      setStackWorkInstallDir msystem-      cleanMinorSnapshots deletion cwd mver-    Snapshots -> do-      cwd <- getCurrentDirectory-      setStackSnapshotsDir msystem-      cleanMinorSnapshots deletion cwd mver-    Compilers -> removeGhcMinorInstallation deletion mver msystem-    GHC -> do-      removeMinorsCmd deletion Compilers Nothing mver msystem-      removeMinorsCmd deletion Snapshots Nothing mver msystem-    Default -> do-      isProject <- doesDirectoryExist ".stack-work"-      if isProject-        then removeMinorsCmd deletion Project Nothing mver msystem-        else removeMinorsCmd deletion GHC Nothing mver msystem+removeMinorsCmd deletion mode mrecursion mver msystem = do+  withRecursion True mrecursion $+    case mode of+      Project -> do+        cwd <- getCurrentDirectory+        setStackWorkInstallDir msystem+        cleanMinorSnapshots deletion cwd mver+      Snapshots -> do+        cwd <- getCurrentDirectory+        setStackSnapshotsDir msystem+        cleanMinorSnapshots deletion cwd mver+      Compilers -> removeGhcMinorInstallation deletion mver msystem+      GHC -> do+        removeMinorsCmd deletion Compilers Nothing mver msystem+        removeMinorsCmd deletion Snapshots Nothing mver msystem+      Default -> do+        isProject <- doesDirectoryExist ".stack-work"+        if isProject+          then removeMinorsCmd deletion Project Nothing mver msystem+          else removeMinorsCmd deletion GHC Nothing mver msystem+  remindDelete deletion  purgeOlderCmd :: Deletion -> Natural -> Maybe Recursion -> Maybe String -> IO ()-purgeOlderCmd deletion keep mrecursion msystem =-  withRecursion mrecursion $-  cleanOldStackWork deletion keep msystem+purgeOlderCmd deletion keep mrecursion msystem = do+  withRecursion True mrecursion $+    cleanOldStackWork deletion keep msystem+  remindDelete deletion  deleteWorkCmd :: Deletion -> Maybe Recursion -> IO ()-deleteWorkCmd deletion mrecursion =-  withRecursion mrecursion $-  removeStackWork deletion+deleteWorkCmd deletion mrecursion = do+  withRecursion False mrecursion $+    removeStackWork deletion+  remindDelete deletion  findStackWorks :: IO [FilePath] findStackWorks =   -- ignore find errors (e.g. access rights)-  cmdIgnoreErr "find" [".", "-type", "d", "-name", ".stack-work", "-prune"] []-  >>= fmap L.sort . filterM (doesDirectoryExist . (</> "install")) . lines+  L.sort . lines <$> cmdIgnoreErr "find" [".", "-type", "d", "-name", ".stack-work", "-prune"] []  listStackSubdirs :: IO [FilePath] listStackSubdirs =   listDirectory "." >>= filterM (\f -> doesDirectoryExist (f </> ".stack-work")) . L.sort++remindDelete :: Deletion -> IO ()+remindDelete deletion =+  unless (isDelete deletion) $ putStrLn "\n(use --delete for removal)"
src/Snapshots.hs view
@@ -130,7 +130,8 @@ cleanOldStackWork deletion keep msystem = do   setStackWorkInstallDir msystem   dirs <- sortOn takeFileName . lines <$> shell ( unwords $ "ls" : ["-d", "*/*"])-  let ghcs = groupOn takeFileName dirs+  let ghcs = sortOn (readVersion . takeFileName . head) $+             groupOn takeFileName dirs   mapM_ removeOlder ghcs   where     removeOlder :: [FilePath] -> IO ()
stack-clean-old.cabal view
@@ -1,5 +1,5 @@ name:                stack-clean-old-version:             0.4.3+version:             0.4.4 synopsis:            Clean away old stack build artefacts description:         A tool for removing old .stack-work/install builds and@@ -9,7 +9,7 @@ license-file:        LICENSE author:              Jens Petersen <juhpetersen@gmail.com> maintainer:          Jens Petersen <juhpetersen@gmail.com>-copyright:           2020-2021  Jens Petersen <juhpetersen@gmail.com>+copyright:           2020-2022  Jens Petersen <juhpetersen@gmail.com> homepage:            https://github.com/juhp/stack-clean-old bug-reports:         https://github.com/juhp/stack-clean-old/issues build-type:          Simple