replace --dryrun with --delete (#6)

- bump version to 0.4
- replace Bool with Deletion type

src/GHC.hs

@@ -14,6 +14,7 @@ import System.FilePath
 
 import Directories (getStackSubdir, globDirs, switchToSystemDirUnder)
 import qualified Remove
+import Types
 import Versions
 
 getStackProgramsDir :: IO FilePath
@@ -51,31 +52,31 @@ listGhcInstallation mghcver = do
     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

@@ -14,6 +14,7 @@ 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
 
@@ -28,13 +29,13 @@ main = do
     , Subcommand "list" "List sizes per ghc version" $
       listCmd <$> modeOpt <*> optional ghcVerArg
     , Subcommand "remove" "Remove for a ghc version" $
-      removeCmd <$> dryrun <*> modeOpt <*> ghcVerArg
+      removeCmd <$> deleteOpt <*> modeOpt <*> ghcVerArg
     , Subcommand "keep-minor" "Remove for previous ghc minor versions" $
-      removeMinorsCmd <$> dryrun <*> modeOpt <*> optional ghcVerArg
+      removeMinorsCmd <$> deleteOpt <*> modeOpt <*> optional ghcVerArg
     , Subcommand "purge-older" "Purge older builds in .stack-work/install" $
-      cleanOldStackWork <$> dryrun <*> keepOption
+      cleanOldStackWork <$> deleteOpt <*> 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"
+      removeStackWorks <$> deleteOpt <*> switchWith 'a' "all" "Find all .stack-work/ subdirs, even if current directory not a stack project"
     ]
   where
     modeOpt =
@@ -43,7 +44,7 @@ main = do
       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" "Without this option dryrun is done"
 
     notHumanOpt = switchWith 'H' "not-human-size" "Do not use du --human-readable"
 
@@ -85,44 +86,44 @@ listCmd mode mver =
         then listCmd Project mver
         else listCmd GHC mver
 
-removeCmd :: Bool -> Mode -> Version -> IO ()
-removeCmd dryrun mode ghcver =
+removeCmd :: Deletion -> Mode -> Version -> IO ()
+removeCmd deletion mode ghcver =
   case mode of
     Project -> do
       cwd <- getCurrentDirectory
       setStackWorkDir
-      cleanGhcSnapshots dryrun cwd ghcver
+      cleanGhcSnapshots deletion cwd ghcver
     Snapshots -> do
       cwd <- getCurrentDirectory
       setStackSnapshotsDir
-      cleanGhcSnapshots dryrun cwd ghcver
-    Compilers -> removeGhcVersionInstallation dryrun ghcver
+      cleanGhcSnapshots deletion cwd ghcver
+    Compilers -> removeGhcVersionInstallation deletion ghcver
     GHC -> do
-      removeCmd dryrun Compilers ghcver
-      removeCmd dryrun Snapshots ghcver
+      removeCmd deletion Compilers ghcver
+      removeCmd deletion Snapshots ghcver
     Default -> do
       isProject <- doesDirectoryExist ".stack-work"
       if isProject
-        then removeCmd dryrun Project ghcver
-        else removeCmd dryrun GHC ghcver
+        then removeCmd deletion Project ghcver
+        else removeCmd deletion GHC ghcver
 
-removeMinorsCmd :: Bool -> Mode -> Maybe Version -> IO ()
-removeMinorsCmd dryrun mode mver =
+removeMinorsCmd :: Deletion -> Mode -> Maybe Version -> IO ()
+removeMinorsCmd deletion mode mver =
   case mode of
     Project -> do
       cwd <- getCurrentDirectory
       setStackWorkDir
-      cleanMinorSnapshots dryrun cwd mver
+      cleanMinorSnapshots deletion cwd mver
     Snapshots -> do
       cwd <- getCurrentDirectory
       setStackSnapshotsDir
-      cleanMinorSnapshots dryrun cwd mver
-    Compilers -> removeGhcMinorInstallation dryrun mver
+      cleanMinorSnapshots deletion cwd mver
+    Compilers -> removeGhcMinorInstallation deletion mver
     GHC -> do
-      removeMinorsCmd dryrun Compilers mver
-      removeMinorsCmd dryrun Snapshots mver
+      removeMinorsCmd deletion Compilers mver
+      removeMinorsCmd deletion Snapshots mver
     Default -> do
       isProject <- doesDirectoryExist ".stack-work"
       if isProject
-        then removeMinorsCmd dryrun Project mver
-        else removeMinorsCmd dryrun GHC mver
+        then removeMinorsCmd deletion Project mver
+        else removeMinorsCmd deletion GHC mver

src/Remove.hs

@@ -8,19 +8,21 @@ where
 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

@@ -28,6 +28,7 @@ import Text.Printf
 
 import Directories (globDirs, getStackSubdir, switchToSystemDirUnder)
 import qualified Remove
+import Types
 import Versions
 
 data SnapshotInstall =
@@ -84,13 +85,13 @@ listGhcSnapshots mghcver = do
   ghcs <- getSnapshotDirs mghcver
   mapM_ printTotalGhcSize ghcs
 
-removeVersionSnaps :: Bool -> FilePath -> VersionSnapshots -> IO ()
-removeVersionSnaps dryrun cwd versnap = do
+removeVersionSnaps :: Deletion -> FilePath -> VersionSnapshots -> IO ()
+removeVersionSnaps deletion cwd versnap = do
   let dirs = snapsHashes versnap
   dir <- getCurrentDirectory
   home <- getHomeDirectory
-  putStrLn $ plural (length dirs) "dir" ++ " in " ++ renderDir home dir ++ " " ++ (if dryrun then "would be " else "") ++ "removed for " ++ showVersion (snapsVersion versnap)
-  mapM_ (Remove.doRemoveDirectory dryrun) dirs
+  putStrLn $ plural (length dirs) "dir" ++ " in " ++ renderDir home dir ++ " " ++ (if isDelete deletion then "" else "would be ") ++ "removed for " ++ showVersion (snapsVersion versnap)
+  mapM_ (Remove.doRemoveDirectory deletion) dirs
   where
     plural :: Int -> String -> String
     plural n thing = show n ++ " " ++ thing ++ if n == 1 then "" else "s"
@@ -101,31 +102,31 @@ removeVersionSnaps dryrun cwd versnap = do
         Just reldir -> reldir
         Nothing -> "~" </> dropPrefix (home ++ "/") fp
 
-cleanGhcSnapshots :: Bool -> FilePath -> Version -> IO ()
-cleanGhcSnapshots dryrun cwd ghcver = do
+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 cwd) ghcs
+    Remove.prompt deletion ("all " ++ showVersion ghcver ++ " builds")
+  mapM_ (removeVersionSnaps deletion cwd) ghcs
 
-cleanMinorSnapshots :: Bool -> FilePath -> Maybe Version -> IO ()
-cleanMinorSnapshots dryrun cwd mghcver = do
+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 cwd) (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 cwd) gminors
+      mapM_ (removeVersionSnaps deletion cwd) gminors
 
-cleanOldStackWork :: Bool -> Int -> IO ()
-cleanOldStackWork dryrun keep = do
+cleanOldStackWork :: Deletion -> Int -> IO ()
+cleanOldStackWork deletion keep = do
   setStackWorkDir
   dirs <- sortOn takeFileName . lines <$> shell ( unwords $ "ls" : ["-d", "*/*"])
   let ghcs = groupOn takeFileName dirs
@@ -135,7 +136,7 @@ cleanOldStackWork dryrun keep = do
     removeOlder dirs = do
       let ghcver = (takeFileName . head) dirs
       oldfiles <- drop keep . reverse <$> sortedByAge
-      mapM_ (Remove.doRemoveDirectory dryrun . takeDirectory) oldfiles
+      mapM_ (Remove.doRemoveDirectory deletion . takeDirectory) oldfiles
       unless (null oldfiles) $
         putStrLn $ show (length oldfiles) ++ " dirs removed for " ++ ghcver
       where
@@ -171,8 +172,8 @@ setStackSnapshotsDir :: IO ()
 setStackSnapshotsDir = do
   getStackSubdir "snapshots" >>= switchToSystemDirUnder
 
-removeStackWorks :: Bool -> Bool -> IO ()
-removeStackWorks dryrun allrecurse = do
+removeStackWorks :: Deletion -> Bool -> IO ()
+removeStackWorks deletion allrecurse = do
   recurse <-
     if allrecurse then return True
     else doesDirectoryExist ".stack-work"
@@ -181,6 +182,6 @@ removeStackWorks dryrun allrecurse = do
     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
+      Remove.prompt deletion "these dirs"
+      mapM_ (Remove.doRemoveDirectory deletion) workdirs
     else error' "run in a project dir (containing .stack-work/)\n or use --all to find and remove all .stack-work/ subdirectories"

src/Types.hs

@@ -0,0 +1,11 @@
+module Types (
+  Deletion (..),
+  isDelete
+  )
+where
+
+data Deletion = Dryrun | Delete
+  deriving Eq
+
+isDelete :: Deletion -> Bool
+isDelete = (== Delete)

stack-clean-old.cabal

@@ -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 @@ executable stack-clean-old
                        GHC
                        Remove
                        Snapshots
+                       Types
                        Versions
   hs-source-dirs:      src
   build-depends:       base >= 4.8 && < 5