perf: Only check the repo the check_suite event was for.

src/GitHub/Tools/AutoMerge.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
-module GitHub.Tools.AutoMerge (autoMergeAll) where
+module GitHub.Tools.AutoMerge (autoMergeRepo, autoMergeAll) where
 
 import           Data.Text                    (Text)
 import qualified Data.Text                    as Text
@@ -9,7 +9,7 @@ import           System.Posix.Directory       (changeWorkingDirectory)
 import           System.Process               (callProcess)
 
 import           GitHub.Tools.PullRequestInfo (PullRequestInfo (..))
-import           GitHub.Tools.PullStatus      (getPullInfos)
+import           GitHub.Tools.PullStatus      (getPullInfos, getPullInfosFor)
 
 
 trustedAuthors :: [Text]
@@ -23,14 +23,18 @@ trustedAuthors =
     ]
 
 
+workDir :: FilePath
+workDir = "/tmp/automerge"
+
+
 autoMerge
     :: String
     -> GitHub.Name GitHub.Organization
     -> PullRequestInfo
     -> IO ()
 autoMerge _ _ PullRequestInfo{prOrigin = Nothing} = return ()
 autoMerge token orgName PullRequestInfo{prRepoName, prUser, prBranch, prOrigin = Just prOrigin} = do
-    let clonePath = "/tmp/automerge/" <> Text.unpack prRepoName
+    let clonePath = workDir <> "/" <> Text.unpack prRepoName
     callProcess "rm" ["-rf", clonePath]
     callProcess "git"
         [ "clone", "--depth=2"  -- 2 so we have a base commit (hopefully the master HEAD commit)
@@ -47,12 +51,28 @@ autoMerge token orgName PullRequestInfo{prRepoName, prUser, prBranch, prOrigin =
     callProcess "git"
         [ "push", "upstream", Text.unpack prBranch <> ":master" ]
 
+    -- Go back to a directory that will definitely exist even when next time
+    -- we "rm -rf" the git repo cloned above.
+    changeWorkingDirectory workDir
+
 
 mergeable :: PullRequestInfo -> Bool
 mergeable PullRequestInfo{prState, prTrustworthy, prUser} =
     prState == "clean" && (prTrustworthy || prUser `elem` trustedAuthors)
 
 
+autoMergeRepo
+  :: GitHub.Name GitHub.Owner
+  -> GitHub.Name GitHub.Organization
+  -> GitHub.Name GitHub.Repo
+  -> String
+  -> GitHub.Auth
+  -> IO ()
+autoMergeRepo ownerName orgName repoName token auth = do
+    pulls <- filter mergeable <$> getPullInfosFor ownerName repoName (Just auth)
+    mapM_ (autoMerge token orgName) pulls
+
+
 autoMergeAll
   :: GitHub.Name GitHub.Organization
   -> GitHub.Name GitHub.Owner

src/GitHub/Tools/PullStatus.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module GitHub.Tools.PullStatus
   ( getPullStatus
+  , getPullInfosFor
   , getPullInfos
   , showPullInfos
   ) where
@@ -91,6 +92,15 @@ getPrsForRepo auth mgr ownerName repoName =
       -- Get more details about each PR.
       >>= Parallel.mapM (getPrInfo auth mgr ownerName repoName))
 
+getPullInfosFor
+  :: GitHub.Name GitHub.Owner
+  -> GitHub.Name GitHub.Repo
+  -> Maybe GitHub.Auth
+  -> IO [PullRequestInfo]
+getPullInfosFor ownerName repoName auth = do
+  mgr <- newManager tlsManagerSettings
+  getPrsForRepo auth mgr ownerName repoName
+
 
 getPullInfos
   :: GitHub.Name GitHub.Organization

tools/hub-automerge.hs

@@ -3,15 +3,19 @@
 module Main (main) where
 
 import qualified Data.ByteString.Char8  as BS8
+import           Data.String            (fromString)
 import qualified GitHub
-import           System.Environment     (getEnv)
+import           System.Environment     (getArgs, getEnv)
 
-import           GitHub.Tools.AutoMerge (autoMergeAll)
+import           GitHub.Tools.AutoMerge (autoMergeAll, autoMergeRepo)
 
 
 main :: IO ()
 main = do
     -- Get auth token from the $GITHUB_TOKEN environment variable.
+    args <- getArgs
     token <- getEnv "GITHUB_TOKEN"
     let auth = GitHub.OAuth . BS8.pack $ token
-    autoMergeAll "TokTok" "TokTok" token auth
+    case args of
+      []    -> autoMergeAll "TokTok" "TokTok" token auth
+      repos -> mapM_ (\repo -> autoMergeRepo "TokTok" "TokTok" (fromString repo) token auth) repos

web/TokTok/Handlers.hs

@@ -7,9 +7,10 @@ module TokTok.Handlers
 import qualified Data.ByteString.Char8  as BS8
 import           Data.Maybe             (fromMaybe)
 import qualified GitHub
-import           GitHub.Tools.AutoMerge (autoMergeAll)
+import           GitHub.Data.Name       (Name (..))
+import           GitHub.Tools.AutoMerge (autoMergeRepo)
 import           GitHub.Types           (CheckSuite (..), CheckSuiteEvent (..),
-                                         Payload (..))
+                                         Payload (..), Repository (..))
 import           System.Environment     (getEnv)
 
 
@@ -19,6 +20,7 @@ handleEvent (CheckSuiteEventPayload event)
       -- Get auth token from the $GITHUB_TOKEN environment variable.
       token <- getEnv "GITHUB_TOKEN"
       let auth = GitHub.OAuth . BS8.pack $ token
-      autoMergeAll "TokTok" "TokTok" token auth
+      let repo = repositoryName . checkSuiteEventRepository $ event
+      autoMergeRepo "TokTok" "TokTok" (N repo) token auth
 
 handleEvent _ = return ()