From 3ee83e6f29a64f03e641481978cbc1a846975ee0 Mon Sep 17 00:00:00 2001
From: Jens Petersen <juhpetersen@gmail.com>
Date: Wed, 13 Sep 2023 14:44:03 +0800
Subject: [PATCH] add --yes option for --delete

eg on Stackage delete-work maybe requires 1000s of prompts
---
 src/GHC.hs        |  6 +++---
 src/GHCTarball.hs |  6 +++---
 src/Main.hs       |  5 ++++-
 src/Snapshots.hs  |  4 ++--
 src/Types.hs      | 13 +++++++++----
 5 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/src/GHC.hs b/src/GHC.hs
index 32a9152..334a232 100644
--- a/src/GHC.hs
+++ b/src/GHC.hs
@@ -68,9 +68,9 @@ removeGhcVersionInstallation deletion ghcver msystem = do
         if isMajorVersion ghcver
         then do
           yes <-
-            if isDelete deletion then
-              yesNo $ "Delete all stack ghc" +-+ showVersion ghcver +-+ "installations"
-              else return True
+            if deletePrompt deletion
+            then yesNo $ "Delete all stack ghc" +-+ showVersion ghcver +-+ "installations"
+            else return True
           when yes $
             mapM_ (doRemoveGhcVersion deletion) gs
         else error' "more than one match found!!"
diff --git a/src/GHCTarball.hs b/src/GHCTarball.hs
index 7864fde..afdc808 100644
--- a/src/GHCTarball.hs
+++ b/src/GHCTarball.hs
@@ -63,9 +63,9 @@ removeGhcVersionTarball deletion ghcver msystem = do
         if isMajorVersion ghcver
         then do
           yes <-
-            if isDelete deletion then
-              yesNo $ "Delete all stack ghc" +-+ showVersion ghcver +-+ "tarballs"
-              else return True
+            if deletePrompt deletion
+            then yesNo $ "Delete all stack ghc" +-+ showVersion ghcver +-+ "tarballs"
+            else return True
           when yes $
             mapM_ (doRemoveGhcTarballVersion deletion) gs
         else error' "more than one match found!!"
diff --git a/src/Main.hs b/src/Main.hs
index 818fc63..caa9a3b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -82,7 +82,10 @@ main = do
       flagWith' Tarballs 'T' "tarballs" ("Act on" +-+ stackroot </> "programs/ tarballs") <|>
       flagWith Default Global 'G' "global" ("Act on both" +-+ stackroot </> "{programs,snapshots}/ [default outside project dir]")
 
-    deleteOpt = flagWith Dryrun Delete 'd' "delete" "Do deletion [default is dryrun]"
+    deleteOpt =
+      (flagWith' Delete 'd' "delete" "Do deletion [default is dryrun]" <*>
+      switchWith 'y' "yes" "Assume yes for all prompts") <|>
+      pure Dryrun
 
     recursionOpt =
       optional (
diff --git a/src/Snapshots.hs b/src/Snapshots.hs
index 7dc77db..fb467cb 100644
--- a/src/Snapshots.hs
+++ b/src/Snapshots.hs
@@ -111,7 +111,7 @@ cleanGhcSnapshots deletion cwd ghcver platform = do
     unless (null ghcs) $
       putStrLn (platform ++ ":")
     yes <-
-      if isMajorVersion ghcver && isDelete deletion
+      if isMajorVersion ghcver && deletePrompt deletion
       then yesNo $ "Delete all" +-+ showVersion ghcver +-+ "builds"
       else return True
     when yes $
@@ -181,7 +181,7 @@ printTotalGhcSize versnaps = do
 removeStackWork :: Deletion -> IO ()
 removeStackWork deletion = do
   yes <-
-    if isDelete deletion
+    if deletePrompt deletion
     then yesNo "Delete .stack-work"
     else return True
   when yes $
diff --git a/src/Types.hs b/src/Types.hs
index 5d0fc60..909d0a0 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -1,11 +1,16 @@
 module Types (
   Deletion (..),
-  isDelete
+  isDelete,
+  deletePrompt
   )
 where
 
-data Deletion = Dryrun | Delete
-  deriving Eq
+data Deletion = Dryrun | Delete Bool
 
 isDelete :: Deletion -> Bool
-isDelete = (== Delete)
+isDelete (Delete _) = True
+isDelete Dryrun = False
+
+deletePrompt :: Deletion -> Bool
+deletePrompt (Delete False) = True
+deletePrompt _ = False