diff --git a/app/Main.hs b/app/Main.hs index fe10680..a7d34ed 100644 --- a/app/Main.hs +++ b/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 diff --git a/src/DeleteMerged.hs b/src/DeleteMerged.hs index 69f3898..c6d0ed1 100644 --- a/src/DeleteMerged.hs +++ b/src/DeleteMerged.hs @@ -11,15 +11,17 @@ import qualified GH import GitHub.Data (Name, Owner) import qualified Git -deleteDone :: Text -> Name Owner -> IO () -deleteDone githubToken ghUser = do +deleteDone :: Bool -> Text -> Name Owner -> IO () +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 () diff --git a/src/GH.hs b/src/GH.hs index 3bcad48..ba7a781 100644 --- a/src/GH.hs +++ b/src/GH.hs @@ -121,28 +121,28 @@ autoUpdateRefs auth ghUser = where prefix = "refs/heads/auto-update/" -openPRWithAutoUpdateRefFromRRyanTM :: GH.Auth -> Text -> IO (Either Text Bool) -openPRWithAutoUpdateRefFromRRyanTM auth ref = +openPRWithAutoUpdateRefFrom :: GH.Auth -> GH.Name GH.Owner -> Text -> IO (Either Text Bool) +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 auth ref = +refShouldBeDeleted :: GH.Auth -> GH.Name GH.Owner -> Text -> IO Bool +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))