Codebase list github-backup / run/f617f642-a87e-4cc6-bd6d-2b56711c3178/main gitriddance.hs
run/f617f642-a87e-4cc6-bd6d-2b56711c3178/main

Tree @run/f617f642-a87e-4cc6-bd6d-2b56711c3178/main (Download .tar.gz)

gitriddance.hs @run/f617f642-a87e-4cc6-bd6d-2b56711c3178/main — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
{- gitriddance - close all open issues and pull requests
 -
 - Copyright 2014 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Main where

import qualified GitHub.Endpoints.Repos as Github
import qualified GitHub.Endpoints.Issues as Github
import qualified GitHub.Endpoints.Issues.Comments as Github
import qualified GitHub.Data.Id as Github
import System.Environment
import Data.String
import qualified Data.Text as T

import Common
import qualified Git
import qualified Git.Construct
import qualified Git.Config
import Github.GetAuth
import Github.EnumRepos

main :: IO ()
main = do
	auth <- fromMaybe (error "Must set GITHUB_USER and GITHUB_PASSWORD")
		<$> getAuth
	r <- maybe (error "not in a git repository") Git.Config.read
		=<< Git.Construct.fromCwd
	rs <- Git.Construct.fromRemotes r
	msg <- maybe (getMsg r) id <$> (headMaybe <$> getArgs)
	case map snd $ filter (isOriginRemote . fst) $ gitHubPairs rs of
		[] -> error "origin does not seem to be a github repository"
		[origin] -> closeall auth origin msg
		_ -> error "somehow found multiple origin repos; this should be impossible!"

getMsg :: Git.Repo -> String
getMsg r = fromMaybe (error "core.gitriddance needs to be set to a message to use when closing issues/pull requests (or pass the message on the command line)")
	(Git.Config.getMaybe "core.gitriddance" r)

{- Identify the origin remote; we don't want to affect any
 - other remotes that might be on github. -}
isOriginRemote :: Git.Repo -> Bool
isOriginRemote rmt = Git.remoteName rmt == Just "origin"

closeall :: Github.Auth -> GithubUserRepo -> String -> IO ()
closeall auth (GithubUserRepo user repo) msg =
	either (oops "getting issue list") (mapM_ close)
		=<< Github.issuesForRepo' (Just auth) (fromString user) (fromString repo) Github.stateOpen
  where
	oops action err = error $ "failed " ++ action ++ ": " ++ show err
	close issue = do
		let i = Github.issueNumber issue
		putStrLn $ "closing issue: " ++ T.unpack (Github.issueTitle issue)
		either (oops "posting comment") (const $ return ())
			=<< Github.createComment auth (fromString user) (fromString repo) i (T.pack msg)
		either (oops "closing issue/pull") (const $ return ())
			=<< Github.editIssue auth (fromString user) (fromString repo) (Github.mkId (Github.Id 0) (Github.unIssueNumber i))
				(Github.editOfIssue { Github.editIssueState = Just Github.StateClosed } )