fix delete-done, don't delete unless --delete passed

fixes #213

app/Main.hs

@@ -9,6 +9,7 @@ import Control.Applicative ((<**>))
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import DeleteMerged (deleteDone)
+import Git
 import NVD (withVulnDB)
 import qualified Nix
 import qualified Options.Applicative as O
@@ -18,7 +19,6 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import qualified System.Posix.Env as P
 import Update (cveAll, cveReport, sourceGithubAll, updateAll, updatePackage)
 import Utils (Options (..), UpdateEnv (..), getGithubToken, getGithubUser)
-import Git
 
 default (T.Text)
 
@@ -34,7 +34,7 @@ data UpdateOptions
 data Command
   = UpdateList UpdateOptions
   | Update UpdateOptions Text
-  | DeleteDone
+  | DeleteDone Bool
   | Version
   | UpdateVulnDB
   | CheckAllVulnerable
@@ -57,6 +57,11 @@ updateParser =
     <$> updateOptionsParser
     <*> O.strArgument (O.metavar "UPDATE_INFO" <> O.help "update string of the form: 'pkg oldVer newVer update-page'\n\n example: 'tflint 0.15.0 0.15.1 repology.org'")
 
+deleteDoneParser :: O.Parser Command
+deleteDoneParser =
+  DeleteDone
+    <$> O.flag False True (O.long "delete" <> O.help "Actually delete the done branches. Otherwise just prints the branches to delete.")
+
 commandParser :: O.Parser Command
 commandParser =
   O.hsubparser
@@ -69,7 +74,7 @@ commandParser =
         <> O.command
           "delete-done"
           ( O.info
-              (pure DeleteDone)
+              deleteDoneParser
               (O.progDesc "Deletes branches from PRs that were merged or closed")
           )
         <> O.command
@@ -128,9 +133,9 @@ main = do
   P.setEnv "GITHUB_TOKEN" (T.unpack token) True
   P.setEnv "PAGER" "" True
   case command of
-    DeleteDone -> do
+    DeleteDone delete -> do
       Git.setupNixpkgs token
-      deleteDone token ghUser
+      deleteDone delete token ghUser
     UpdateList UpdateOptions {pr, cachix, cve, nixpkgsReview, outpaths} -> do
       updates <- T.readFile "packages-to-update.txt"
       Git.setupNixpkgs token

src/DeleteMerged.hs

@@ -11,15 +11,17 @@ import qualified GH
 import GitHub.Data (Name, Owner)
 import qualified Git
 
-deleteDone :: Text -> Name Owner -> IO ()
+deleteDone :: Bool -> Text -> Name Owner -> IO ()
-deleteDone githubToken ghUser = do
+deleteDone delete githubToken ghUser = do
   result <-
     runExceptT $ do
       Git.fetch
       Git.cleanAndResetTo "master"
       refs <- ExceptT $ GH.closedAutoUpdateRefs (GH.authFromToken githubToken) ghUser
       let branches = fmap (\r -> ("auto-update/" <> r)) refs
-      liftIO $ Git.deleteBranchesEverywhere branches
+      if delete
+      then liftIO $ Git.deleteBranchesEverywhere branches
+      else liftIO $ T.putStrLn $ tshow branches
   case result of
     Left e -> T.putStrLn e
     _ -> return ()

src/GH.hs

@@ -121,28 +121,28 @@ autoUpdateRefs auth ghUser =
   where
     prefix = "refs/heads/auto-update/"
 
-openPRWithAutoUpdateRefFromRRyanTM :: GH.Auth -> Text -> IO (Either Text Bool)
+openPRWithAutoUpdateRefFrom :: GH.Auth -> GH.Name GH.Owner -> Text -> IO (Either Text Bool)
-openPRWithAutoUpdateRefFromRRyanTM auth ref =
+openPRWithAutoUpdateRefFrom auth ghUser ref =
   GH.executeRequest
     auth
     ( GH.pullRequestsForR
         "nixos"
         "nixpkgs"
-        (GH.optionsHead ("bhipple:" <> U.branchPrefix <> ref) <> GH.stateOpen)
+        (GH.optionsHead (tshow ghUser <> ":" <> U.branchPrefix <> ref) <> GH.stateOpen)
         GH.FetchAll
     )
     & fmap (first (T.pack . show) >>> second (not . V.null))
 
-refShouldBeDeleted :: GH.Auth -> Text -> IO Bool
+refShouldBeDeleted :: GH.Auth -> GH.Name GH.Owner -> Text -> IO Bool
-refShouldBeDeleted auth ref =
+refShouldBeDeleted auth ghUser ref =
   not . either (const True) id
-    <$> openPRWithAutoUpdateRefFromRRyanTM auth ref
+    <$> openPRWithAutoUpdateRefFrom auth ghUser ref
 
 closedAutoUpdateRefs :: GH.Auth -> GH.Name GH.Owner -> IO (Either Text (Vector Text))
 closedAutoUpdateRefs auth ghUser =
   runExceptT $ do
     aur :: Vector Text <- ExceptT $ GH.autoUpdateRefs auth ghUser
-    ExceptT (Right <$> V.filterM (refShouldBeDeleted auth) aur)
+    ExceptT (Right <$> V.filterM (refShouldBeDeleted auth ghUser) aur)
 
 -- This is too slow
 openPullRequests :: Text -> IO (Either Text (Vector GH.SimplePullRequest))