packages feed

stack-clean-old 0.3.1 → 0.4

raw patch · 9 files changed

+235/−131 lines, 9 files

Files

ChangeLog.md view
@@ -1,5 +1,12 @@ # Release history for stack-clean-old-work +## 0.4 (2021-09-26)+- dryrun is now default: use --delete for actual removal+  (suggested by @andreasabel #6)+- new --subdirs and --recursive options+- various output improvements+- purge-older now also says "would be removed" when dryrun+ ## 0.3.1 (2021-08-01) - 'delete-work': use find -prune and ignore inaccessible files (@petrem, #4)
README.md view
@@ -5,7 +5,7 @@  ## Usage ```-stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-p|--project) | (-g|--ghc)] [GHCVER]+stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-p|--project) | (-g|--ghc)] [--delete] [GHCVER] ``` Options: @@ -26,7 +26,7 @@     removes for the specified ghc version (the GHCVER argument is required).  `keep-minor`:-    removes the builds/installs for previous minor ghc versions.+    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.  `purge-older` and `delete-work`:@@ -36,8 +36,9 @@ 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 `--dry-run` (`-n`), so please use it to-check the effect of running them safely beforehand.+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.  ### Example usage To remove project builds for ghc-8.2.2:@@ -46,7 +47,7 @@ 154M  8.2.2  (5 dirs) 154M  8.4.4  (5 dirs) 163M  8.6.5  (5 dirs)-$ stack-clean-old remove -p 8.2.2+$ stack-clean-old remove --delete -p 8.2.2 ```  Remove stack ghc-8.4 snapshot builds and compilers before 8.4.4:@@ -56,7 +57,7 @@ 368M  8.4.2  (6 dirs) 489M  8.4.3  (8 dirs) 799M  8.4.4  (24 dirs)-$ stack-clean-old keep-minor -g 8.4.4+$ stack-clean-old keep-minor -d -g 8.4.4 ghc-tinfo6-8.4.3 removed 7 dirs removed for 8.4.1 6 dirs removed for 8.4.2@@ -82,7 +83,7 @@ (seems same as `stack clean --full`).  `stack-clean-old delete-work --all` works from outside stack projects:-please test with `--dry-run` first.+please use with care.  ## Installation @@ -92,12 +93,16 @@ 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. +[cabal-clean](https://hackage.haskell.org/package/cabal-clean) is+a similar tool for cleaning old cached cabal build files.+ ## 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, as also mentioned in LICENSE.+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.
src/Directories.hs view
@@ -5,7 +5,6 @@   ) where -import Control.Monad.Extra import Data.List.Extra import SimpleCmd (error') import System.Directory@@ -23,14 +22,16 @@  switchToSystemDirUnder :: FilePath -> IO () switchToSystemDirUnder dir = do-  ifM (doesDirectoryExist dir)-    (setCurrentDirectory dir)-    (error' $ dir ++ " not found")+  exists <- doesDirectoryExist dir+  if exists+    then setCurrentDirectory dir+    else error' $ dir ++ " not found"   systems <- listDirectory "."   -- FIXME be more precise/check "system" dirs   -- eg 64bit intel Linux: x86_64-linux-tinfo6-  let system = case systems of-        [] -> error' $ "No OS system in " ++ dir-        [sys] -> sys-        _ -> error' "More than one OS systems found " ++ dir ++ " (unsupported)"+  let system =+        case systems of+          [] -> error' $ "No OS system in " ++ dir+          [sys] -> sys+          _ -> error' "More than one OS systems found " ++ dir ++ " (unsupported)"   setCurrentDirectory system
src/GHC.hs view
@@ -14,6 +14,7 @@  import Directories (getStackSubdir, globDirs, switchToSystemDirUnder) import qualified Remove+import Types import Versions  getStackProgramsDir :: IO FilePath@@ -51,31 +52,31 @@     Nothing -> dirs     Just ghcver -> filter ((== ghcver) . (if isMajorVersion ghcver then majorVersion else id) . ghcInstallVersion) dirs -removeGhcVersionInstallation :: Bool -> Version -> IO ()-removeGhcVersionInstallation dryrun ghcver = do+removeGhcVersionInstallation :: Deletion -> Version -> IO ()+removeGhcVersionInstallation deletion ghcver = do   installs <- getGhcInstallDirs (Just ghcver)   case installs of     [] -> putStrLn $ "stack ghc compiler version " ++ showVersion ghcver ++ " not found"-    [g] | not (isMajorVersion ghcver) -> doRemoveGhcVersion dryrun g+    [g] | not (isMajorVersion ghcver) -> doRemoveGhcVersion deletion g     gs -> if isMajorVersion ghcver then do-      Remove.prompt dryrun ("all stack ghc " ++ showVersion ghcver ++ " installations: ")-      mapM_ (doRemoveGhcVersion dryrun) gs+      Remove.prompt deletion ("all stack ghc " ++ showVersion ghcver ++ " installations: ")+      mapM_ (doRemoveGhcVersion deletion) gs       else error' "more than one match found!!" -removeGhcMinorInstallation :: Bool -> Maybe Version -> IO ()-removeGhcMinorInstallation dryrun mghcver = do+removeGhcMinorInstallation :: Deletion -> Maybe Version -> IO ()+removeGhcMinorInstallation deletion mghcver = do   dirs <- getGhcInstallDirs (majorVersion <$> mghcver)   case mghcver of     Nothing -> do       let majors = groupOn (majorVersion . ghcInstallVersion) dirs       forM_ majors $ \ minors ->-        forM_ (init minors) $ doRemoveGhcVersion dryrun+        forM_ (init minors) $ doRemoveGhcVersion deletion     Just ghcver -> do       let minors = filter ((< ghcver) . ghcInstallVersion) dirs-      forM_ minors $ doRemoveGhcVersion dryrun+      forM_ minors $ doRemoveGhcVersion deletion -doRemoveGhcVersion :: Bool -> FilePath -> IO ()-doRemoveGhcVersion dryrun ghcinst = do-  Remove.doRemoveDirectory dryrun ghcinst-  Remove.removeFile dryrun (ghcinst <.> "installed")-  putStrLn $ ghcinst ++ " compiler " ++ (if dryrun then "would be " else "") ++ "removed"+doRemoveGhcVersion :: Deletion -> FilePath -> IO ()+doRemoveGhcVersion deletion ghcinst = do+  Remove.doRemoveDirectory deletion ghcinst+  Remove.removeFile deletion (ghcinst <.> "installed")+  putStrLn $ ghcinst ++ " compiler " ++ (if isDelete deletion then "" else "would be ") ++ "removed"
src/Main.hs view
@@ -5,18 +5,28 @@ #if !MIN_VERSION_simple_cmd_args(0,1,3) import Control.Applicative ((<|>)) #endif+import Control.Monad+import qualified Data.List as L+import Data.List.Extra+import Data.Maybe import Data.Version.Extra+import Numeric.Natural import SimpleCmd import SimpleCmdArgs import System.Directory+import System.FilePath import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)  import GHC import Paths_stack_clean_old (version) import Snapshots+import Types  data Mode = Default | Project | Snapshots | Compilers | GHC +data Recursion = Subdirs | Recursive+  deriving Eq+ main :: IO () main = do   hSetBuffering stdout NoBuffering@@ -24,93 +34,158 @@     "Cleans away old stack-work builds (and pending: stack snapshots) to recover diskspace." $     subcommands     [ Subcommand "size" "Total size" $-      sizeCmd <$> modeOpt <*> notHumanOpt+      sizeCmd <$> modeOpt <*> recursionOpt <*> notHumanOpt     , Subcommand "list" "List sizes per ghc version" $-      listCmd <$> modeOpt <*> optional ghcVerArg+      listCmd <$> modeOpt <*> recursionOpt <*> optional ghcVerArg     , Subcommand "remove" "Remove for a ghc version" $-      removeCmd <$> dryrun <*> modeOpt <*> ghcVerArg+      removeCmd <$> deleteOpt <*> modeOpt <*> recursionOpt <*> ghcVerArg     , Subcommand "keep-minor" "Remove for previous ghc minor versions" $-      removeMinorsCmd <$> dryrun <*> modeOpt <*> optional ghcVerArg+      removeMinorsCmd <$> deleteOpt <*> modeOpt <*> recursionOpt <*> optional ghcVerArg     , Subcommand "purge-older" "Purge older builds in .stack-work/install" $-      cleanOldStackWork <$> dryrun <*> keepOption+      purgeOlderCmd <$> deleteOpt <*> keepOption <*> recursionOpt     , 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"+      deleteWorkCmd <$> deleteOpt <*> recursionOpt     ]   where     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/"+      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"+    deleteOpt = flagWith Dryrun Delete 'd' "delete" "Do deletion [default is dryrun]" +    recursionOpt =+      optional (+      flagWith' Subdirs 's' "subdirs" "List subdirectories"+        <|> flagWith' Recursive 'r' "recursive" "List subdirectories")+     notHumanOpt = switchWith 'H' "not-human-size" "Do not use du --human-readable"      ghcVerArg = readVersion <$> strArg "GHCVER" -    keepOption = positive <$> optionalWith auto 'k' "keep" "INT" "number of project builds per ghc version [default 5]" 5+    keepOption = 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" +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 -sizeCmd :: Mode -> Bool -> IO ()-sizeCmd mode notHuman =+withRecursion' :: Maybe Recursion -> (FilePath -> IO ()) -> IO ()+withRecursion' mrecursion act = do+  case mrecursion of+    Just recursion -> do+      dirs <- if recursion == Recursive+              then map (dropPrefix "./" . takeDirectory) <$> findStackWorks+              else listStackSubdirs+      mapM_ act dirs+    Nothing -> act ""++sizeCmd :: Mode -> Maybe Recursion -> Bool -> IO ()+sizeCmd mode mrecursion notHuman =+  withRecursion' mrecursion $ \dir ->   case mode of-    Project -> sizeStackWork notHuman+    Project -> sizeStackWork notHuman dir     Snapshots -> sizeSnapshots notHuman     Compilers -> sizeGhcInstalls notHuman     GHC -> do-          sizeCmd Compilers notHuman-          sizeCmd Snapshots notHuman-    Default -> do+      sizeCmd Compilers Nothing notHuman+      sizeCmd Snapshots Nothing notHuman+    Default ->+      if isJust mrecursion+      then sizeStackWork notHuman dir+      else do       isProject <- doesDirectoryExist ".stack-work"       if isProject-        then sizeCmd Project notHuman-        else sizeCmd GHC notHuman+        then sizeCmd Project Nothing notHuman+        else sizeCmd GHC Nothing notHuman -listCmd :: Mode -> Maybe Version -> IO ()-listCmd mode mver =+listCmd :: Mode -> Maybe Recursion -> Maybe Version -> IO ()+listCmd mode mrecursion mver =+  withRecursion mrecursion $   case mode of-    Project -> listGhcSnapshots setStackWorkDir mver-    Snapshots -> listGhcSnapshots setStackSnapshotsDir mver+    Project -> setStackWorkInstallDir >> listGhcSnapshots mver+    Snapshots -> setStackSnapshotsDir >> listGhcSnapshots mver     Compilers -> listGhcInstallation mver     GHC -> do-      listCmd Compilers mver-      listCmd Snapshots mver+      listCmd Compilers Nothing mver+      listCmd Snapshots Nothing mver     Default -> do       isProject <- doesDirectoryExist ".stack-work"       if isProject-        then listCmd Project mver-        else listCmd GHC mver+        then listCmd Project Nothing mver+        else listCmd GHC Nothing mver -removeCmd :: Bool -> Mode -> Version -> IO ()-removeCmd dryrun mode ghcver =+removeCmd :: Deletion -> Mode -> Maybe Recursion -> Version -> IO ()+removeCmd deletion mode mrecursion ghcver =+  withRecursion mrecursion $   case mode of-    Project -> cleanGhcSnapshots setStackWorkDir dryrun ghcver-    Snapshots -> cleanGhcSnapshots setStackSnapshotsDir dryrun ghcver-    Compilers -> removeGhcVersionInstallation dryrun ghcver+    Project -> do+      cwd <- getCurrentDirectory+      setStackWorkInstallDir+      cleanGhcSnapshots deletion cwd ghcver+    Snapshots -> do+      cwd <- getCurrentDirectory+      setStackSnapshotsDir+      cleanGhcSnapshots deletion cwd ghcver+    Compilers -> removeGhcVersionInstallation deletion ghcver     GHC -> do-      removeCmd dryrun Compilers ghcver-      removeCmd dryrun Snapshots ghcver+      removeCmd deletion Compilers Nothing ghcver+      removeCmd deletion Snapshots Nothing ghcver     Default -> do       isProject <- doesDirectoryExist ".stack-work"       if isProject-        then removeCmd dryrun Project ghcver-        else removeCmd dryrun GHC ghcver+        then removeCmd deletion Project Nothing ghcver+        else removeCmd deletion GHC Nothing ghcver -removeMinorsCmd :: Bool -> Mode -> Maybe Version -> IO ()-removeMinorsCmd dryrun mode mver =+removeMinorsCmd :: Deletion -> Mode -> Maybe Recursion -> Maybe Version+                -> IO ()+removeMinorsCmd deletion mode mrecursion mver =+  withRecursion mrecursion $   case mode of-    Project -> cleanMinorSnapshots setStackWorkDir dryrun mver-    Snapshots -> cleanMinorSnapshots setStackSnapshotsDir dryrun mver-    Compilers -> removeGhcMinorInstallation dryrun mver+    Project -> do+      cwd <- getCurrentDirectory+      setStackWorkInstallDir+      cleanMinorSnapshots deletion cwd mver+    Snapshots -> do+      cwd <- getCurrentDirectory+      setStackSnapshotsDir+      cleanMinorSnapshots deletion cwd mver+    Compilers -> removeGhcMinorInstallation deletion mver     GHC -> do-      removeMinorsCmd dryrun Compilers mver-      removeMinorsCmd dryrun Snapshots mver+      removeMinorsCmd deletion Compilers Nothing mver+      removeMinorsCmd deletion Snapshots Nothing mver     Default -> do       isProject <- doesDirectoryExist ".stack-work"       if isProject-        then removeMinorsCmd dryrun Project mver-        else removeMinorsCmd dryrun GHC mver+        then removeMinorsCmd deletion Project Nothing mver+        else removeMinorsCmd deletion GHC Nothing mver++purgeOlderCmd :: Deletion -> Natural -> Maybe Recursion -> IO ()+purgeOlderCmd deletion keep mrecursion =+  withRecursion mrecursion $+  cleanOldStackWork deletion keep++deleteWorkCmd :: Deletion -> Maybe Recursion -> IO ()+deleteWorkCmd deletion mrecursion =+  withRecursion mrecursion $+  removeStackWork 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++listStackSubdirs :: IO [FilePath]+listStackSubdirs =+  listDirectory "." >>= filterM (\f -> doesDirectoryExist (f </> ".stack-work")) . L.sort
src/Remove.hs view
@@ -8,19 +8,21 @@ import Control.Monad.Extra import qualified System.Directory as D -doRemoveDirectory :: Bool -> FilePath -> IO ()-doRemoveDirectory dryrun dir =-  unless dryrun $+import Types++doRemoveDirectory :: Deletion -> FilePath -> IO ()+doRemoveDirectory deletion dir =+  when (isDelete deletion) $   D.removeDirectoryRecursive dir -removeFile :: Bool -> FilePath -> IO ()-removeFile dryrun file =-  unless dryrun $+removeFile :: Deletion -> FilePath -> IO ()+removeFile deletion file =+  when (isDelete deletion) $   whenM (D.doesFileExist file) $   D.removeFile file -prompt :: Bool -> String -> IO ()-prompt dryrun str =-  unless dryrun $ do+prompt :: Deletion -> String -> IO ()+prompt deletion str =+  when (isDelete deletion) $ do   putStr $ "Press Enter to delete " ++ str ++ ": "   void getLine
src/Snapshots.hs view
@@ -8,16 +8,17 @@   cleanOldStackWork,   listGhcSnapshots,   setStackSnapshotsDir,-  setStackWorkDir,+  setStackWorkInstallDir,   sizeSnapshots,   sizeStackWork,-  removeStackWorks+  removeStackWork   ) where  import Control.Monad.Extra import Data.List.Extra import Data.Version.Extra+import Numeric.Natural import SimpleCmd #if MIN_VERSION_simple_cmd(0,2,1)   hiding (whenM)@@ -28,6 +29,7 @@  import Directories (globDirs, getStackSubdir, switchToSystemDirUnder) import qualified Remove+import Types import Versions  data SnapshotInstall =@@ -79,46 +81,54 @@   snapshots <- getStackSubdir "snapshots"   cmd_ "du" $ ["-h" | not nothuman] ++ ["-s", snapshots] -listGhcSnapshots :: IO () -> Maybe Version -> IO ()-listGhcSnapshots setdir mghcver = do-  setdir+listGhcSnapshots :: Maybe Version -> IO ()+listGhcSnapshots mghcver = do   ghcs <- getSnapshotDirs mghcver   mapM_ printTotalGhcSize ghcs -removeVersionSnaps :: Bool -> VersionSnapshots -> IO ()-removeVersionSnaps dryrun versnap = do+plural :: String -> Int -> String+plural thing n = show n ++ " " ++ thing ++ if n == 1 then "" else "s"++removeVersionSnaps :: Deletion -> FilePath -> VersionSnapshots -> IO ()+removeVersionSnaps deletion cwd versnap = do   let dirs = snapsHashes versnap-  mapM_ (Remove.doRemoveDirectory dryrun) dirs-  putStrLn $ show (length dirs) ++ " dirs in ~/.stack/snapshots/ " ++ (if dryrun then "would be " else "") ++ "removed for " ++ showVersion (snapsVersion versnap)+  dir <- getCurrentDirectory+  home <- getHomeDirectory+  putStrLn $ plural "dir" (length dirs) ++ " in " ++ renderDir home dir ++ " " ++ (if isDelete deletion then "" else "would be ") ++ "removed for " ++ showVersion (snapsVersion versnap)+  mapM_ (Remove.doRemoveDirectory deletion) dirs+  where+    renderDir :: FilePath -> FilePath -> FilePath+    renderDir home fp =+      case stripPrefix (cwd ++ "/") fp of+        Just reldir -> reldir+        Nothing -> "~" </> dropPrefix (home ++ "/") fp -cleanGhcSnapshots :: IO () -> Bool -> Version -> IO ()-cleanGhcSnapshots setDir dryrun ghcver = do-  setDir+cleanGhcSnapshots :: Deletion -> FilePath -> Version -> IO ()+cleanGhcSnapshots deletion cwd ghcver = do   ghcs <- getSnapshotDirs (Just ghcver)   when (isMajorVersion ghcver) $ do-    Remove.prompt dryrun ("all " ++ showVersion ghcver ++ " builds")-  mapM_ (removeVersionSnaps dryrun) ghcs+    Remove.prompt deletion ("all " ++ showVersion ghcver ++ " builds")+  mapM_ (removeVersionSnaps deletion cwd) ghcs -cleanMinorSnapshots :: IO () -> Bool -> Maybe Version -> IO ()-cleanMinorSnapshots setDir dryrun mghcver = do-  setDir+cleanMinorSnapshots :: Deletion -> FilePath -> Maybe Version -> IO ()+cleanMinorSnapshots deletion cwd mghcver = do   ghcs <- getSnapshotDirs (majorVersion <$> mghcver)   case mghcver of     Nothing -> do       let majors = groupOn (majorVersion . snapsVersion) ghcs       forM_ majors $ \ gmajor ->         when (length gmajor > 1) $-        mapM_ (removeVersionSnaps dryrun) (init gmajor)+        mapM_ (removeVersionSnaps deletion cwd) (init gmajor)     Just ghcver -> do       let newestMinor = if isMajorVersion ghcver                         then (snapsVersion . last) ghcs                         else ghcver           gminors = filter ((< newestMinor) . snapsVersion) ghcs-      mapM_ (removeVersionSnaps dryrun) gminors+      mapM_ (removeVersionSnaps deletion cwd) gminors -cleanOldStackWork :: Bool -> Int -> IO ()-cleanOldStackWork dryrun keep = do-  setStackWorkDir+cleanOldStackWork :: Deletion -> Natural -> IO ()+cleanOldStackWork deletion keep = do+  setStackWorkInstallDir   dirs <- sortOn takeFileName . lines <$> shell ( unwords $ "ls" : ["-d", "*/*"])   let ghcs = groupOn takeFileName dirs   mapM_ removeOlder ghcs@@ -126,10 +136,10 @@     removeOlder :: [FilePath] -> IO ()     removeOlder dirs = do       let ghcver = (takeFileName . head) dirs-      oldfiles <- drop keep . reverse <$> sortedByAge-      mapM_ (Remove.doRemoveDirectory dryrun . takeDirectory) oldfiles+      oldfiles <- drop (fromEnum keep) . reverse <$> sortedByAge+      mapM_ (Remove.doRemoveDirectory deletion . takeDirectory) oldfiles       unless (null oldfiles) $-        putStrLn $ show (length oldfiles) ++ " dirs removed for " ++ ghcver+        putStrLn $ plural "dir" (length oldfiles) ++ (if isDelete deletion then "" else " would be") ++ " removed for " ++ ghcver       where         sortedByAge = do           fileTimes <- mapM newestTimeStamp dirs@@ -144,9 +154,9 @@ stackWorkInstall :: FilePath stackWorkInstall = ".stack-work/install" -sizeStackWork :: Bool -> IO ()-sizeStackWork nothuman = do-  let path = stackWorkInstall+sizeStackWork :: Bool -> FilePath -> IO ()+sizeStackWork nothuman dir = do+  let path = dir </> ".stack-work"   whenM (doesDirectoryExist path) $     cmd_ "du" $ ["-h" | not nothuman] ++ ["-s", path] @@ -155,24 +165,15 @@   total <- head . words . last <$> cmdLines "du" ("-shc":snapsHashes versnaps)   printf "%4s  %-6s (%d dirs)\n" total ((showVersion . snapsVersion) versnaps) (length (snapsHashes versnaps)) -setStackWorkDir :: IO ()-setStackWorkDir = do+setStackWorkInstallDir :: IO ()+setStackWorkInstallDir = do   switchToSystemDirUnder stackWorkInstall  setStackSnapshotsDir :: IO () setStackSnapshotsDir = do   getStackSubdir "snapshots" >>= switchToSystemDirUnder -removeStackWorks :: Bool -> Bool -> IO ()-removeStackWorks dryrun allrecurse = do-  recurse <--    if allrecurse then return True-    else doesDirectoryExist ".stack-work"-  if recurse then do-    -- ignore find errors (e.g. access rights)-    workdirs <- sort . lines <$> cmdIgnoreErr "find" [".", "-type", "d", "-name", ".stack-work", "-prune"] []-    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"+removeStackWork :: Deletion -> IO ()+removeStackWork deletion = do+  Remove.prompt deletion "this dir"+  Remove.doRemoveDirectory deletion ".stack-work"
+ src/Types.hs view
@@ -0,0 +1,11 @@+module Types (+  Deletion (..),+  isDelete+  )+where++data Deletion = Dryrun | Delete+  deriving Eq++isDelete :: Deletion -> Bool+isDelete = (== Delete)
stack-clean-old.cabal view
@@ -1,5 +1,5 @@ name:                stack-clean-old-version:             0.3.1+version:             0.4 synopsis:            Clean away old stack build artefacts description:         A tool for removing old .stack-work/install builds and@@ -29,6 +29,7 @@                        GHC                        Remove                        Snapshots+                       Types                        Versions   hs-source-dirs:      src   build-depends:       base >= 4.8 && < 5