packages feed

github-backup 1.20120126 → 1.20120131

raw patch · 7 files changed

+492/−176 lines, 7 files

Files

+ Github/Data/Readable.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE StandaloneDeriving #-}++-- | This module re-exports the @Github.Data.Definitions@ module, adding+-- instances of @Read@ to it.++module Github.Data.Readable (module Github.Data.Definitions) where++import Github.Data.Definitions++deriving instance Read GithubDate+deriving instance Read GithubUser+deriving instance Read Repo
Makefile view
@@ -1,5 +1,7 @@-GHCFLAGS=-O2 -Wall+BASEFLAGS=-Wall -fno-warn-orphans+GHCFLAGS=-O2 $(BASEFLAGS) bins=github-backup+mans=github-backup.1 all=$(bins)  ifdef PROFILE@@ -16,11 +18,17 @@ all: $(all)  # Disables optimisation. Not for production use.-fast: GHCFLAGS=-Wall+fast: GHCFLAGS=$(BASEFLAGS) fast: $(bins)  $(bins): 	$(GHCMAKE) $@++install: all+	install -d $(DESTDIR)$(PREFIX)/bin+	install $(bins) $(DESTDIR)$(PREFIX)/bin+	install -d $(DESTDIR)$(PREFIX)/share/man/man1+	install -m 0644 $(mans) $(DESTDIR)$(PREFIX)/share/man/man1  clean: 	rm -f $(bins)
README.md view
@@ -1,43 +1,51 @@ github-backup is a simple tool you run in a git repository you cloned from-Github. It backs up everything Github knows about the repository, including-other forks, issues, comments, milestones, pull requests, and watchers.+GitHub. It backs up everything GitHub publishes about the repository,+including other forks, issues, comments, wikis, milestones, pull requests,+and watchers.  ## Installation -  git clone git://github.com/joeyh/github-backup-  cd github-backup-  make-  ./github-backup+    git clone git://github.com/joeyh/github-backup+    cd github-backup+    make  Or use cabal: -  cabal install github-backup --bindir=$HOME/bin+    cabal install github-backup --bindir=$HOME/bin -## Why backup Github+## Use +  Run `github-backup` with no parameters, inside a git repository cloned+  from GitHub to back up that repository.++  Or, run `github-backup username` to clone and back up all of a GitHub+  user's repositories.++## Why backup GitHub repositories+ There are a couple of reasons to want to back this stuff up: -* In case something happens to Github. More generally because+* In case something happens to GitHub. More generally because   keeping your data in the cloud *and* relying on the cloud to   back it up is foolish.  * So you can keep working on your repository while on a plane, or-  on a remote beach or mountiaintop. Just like Linus intended.+  on a remote beach or mountaintop. Just like Linus intended.  ## What to expect -Each time you run github-backup, it will find any new forks of your project-on github. It will add remotes to your repository for the forks, using names-like `github_linus_divemonitor`. It will fetch from every fork.+Each time you run github-backup, it will find any new forks on GitHub. It+will add remotes to your repository for the forks, using names like+`github_linus_divemonitor`. It will fetch from every fork. -Then the next pass will download metadata from each fork. This is stored+It downloads metadata from each fork. This is stored into a branch named "github". Each fork gets a directory in there, like `linus_divemonitor`. Inside the directory there will be some-files, like `linus_divemonitor/watchers`. There maybe be further+files, like `linus_divemonitor/watchers`. There may be further directories, like for comments: `linus_divemonitor/comments/1`.  You can follow the commits to the github branch to see what information-changed on github over time.+changed on GitHub over time.  The format of the files in the github branch is currently Haskell serialized data types. This is plain text, and readable, if you squint.@@ -45,18 +53,36 @@ ## Limitations  github-backup is repository-focused. It does not try to back up other-information from Github. In particular, social network stuff, like+information from GitHub. In particular, social network stuff, like users who are following you, is not backed up. -github-backup will find and backup all forks of a repository, and all forks+github-backup will find and backup forks of a repository, and all forks of those forks, etc. However, it cannot go *up* the fork tree. So if-your Github repositoriy is a fork of something else, the something else+your GitHub repositoriy is a fork of something else, the something else won't be backed up. There is an easy solution though. Just add the parent as a git remote. Then github-backup will find it, and back it up. -Currently, github-backup re-downloads all issues, comments, and so on-each time it's run. This may be slow if your repo has a lot of them.+Currently, only 30 of each thing will be returned. This is a bug in +the haskell github library I'm using. Hope to get it fixed soon. +Currently, the GitHub API does not seem to provide a way to access notes+added to commits and notes added to lines of code. So those notes won't get+backed up. The GitHub folks have been told about this limitation of their API.++The labels that can be added to issues and milestones are not backed up.+Neither are the hooks. They could be, but don't seem important+enough for the extra work involved. Yell if you need them.++github-backup re-downloads all issues, comments, and so on+each time it's run. This may be slow if your repo has a lot of them,+or even if it just has a lot of forks.++Bear in mind that this uses the GitHub API; don't run it every 5 minutes.+GitHub [rate limits](http://developer.github.com/v3/#rate-limiting) the+API to 5000 requests per hour. However, github-backup *does* do an+incremental backup, picking up where it left off, so will complete the+backup eventually even if it's rate limited.+ ## Author  github-backup was written by Joey Hess <joey@kitenet.net>@@ -64,4 +90,4 @@ It is made possible thanks to:  * Mike Burns's [haskell github library](http://hackage.haskell.org/package/github)-* Github, for providing an API exposing this data. +* GitHub, for providing an API exposing this data.
+ Utility/State.hs view
@@ -0,0 +1,26 @@+{- state monad support+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Utility.State where++import Control.Monad.State.Strict++{- Modifies Control.Monad.State's state, forcing a strict update.+ - This avoids building thunks in the state and leaking.+ - Why it's not the default, I don't know.+ -+ - Example: changeState $ \s -> s { foo = bar }+ -}+changeState :: MonadState s m => (s -> s) -> m ()+changeState f = do+	x <- get+	put $! f x++{- Gets a value from the internal state, selected by the passed value+ - constructor. -}+getState :: MonadState s m => (s -> a) -> m a+getState = gets
+ github-backup.1 view
@@ -0,0 +1,17 @@+.\" -*- nroff -*-+.TH github-backup 1 "Commands"+.SH NAME+github-backup \- backs up data from GitHub+.SH SYNOPSIS+.B github-backup [\fIusername\fP]+.SH DESCRIPTION+.I github-backup+is a simple tool you run in a git repository you cloned from+GitHub. It backs up everything GitHub publishes about the repository,+including other forks, issues, comments, wikis, milestones, pull requests,+and watchers.+.PP+Alternately, if you pass it the username of a GitHub user, it will check+out, and back up, all that user's repositories.+.SH AUTHOR +Joey Hess <joey@kitenet.net>
github-backup.cabal view
@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20120126+Version: 1.20120131 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -8,11 +8,12 @@ Copyright: 2012 Joey Hess License-File: GPL Build-Type: Simple-Extra-Source-Files: README.md Makefile Git/Construct.hs Git/Command.hs- Git/Branch.hs Git/Url.hs Git/Ref.hs Git/Sha.hs Git/Types.hs- Git/Config.hs Git/Queue.hs Utility/Misc.hs Common.hs- Utility/TempFile.hs Utility/Monad.hs Utility/PartialPrelude.hs- Utility/Path.hs Utility/Directory.hs Utility/SafeCommand.hs Git.hs+Extra-Source-Files: README.md Makefile github-backup.1+ Common.hs github-backup.hs Git/Url.hs Git/Types.hs Git/Queue.hs Git/Ref.hs+ Git/Branch.hs Git/Sha.hs Git/Config.hs Git/Command.hs Git/Construct.hs+ Setup.hs Github/Data/Readable.hs Utility/Path.hs Utility/TempFile.hs+ Utility/State.hs Utility/Monad.hs Utility/Misc.hs Utility/SafeCommand.hs+ Utility/Directory.hs Utility/PartialPrelude.hs Git.hs Homepage: https://github.com/joeyh/github-backup Category: Utility Synopsis: backs up everything github knows about a repository, to the repository
github-backup.hs view
@@ -5,13 +5,18 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Main where +import qualified Data.Map as M+import qualified Data.Set as S+import Data.Either import System.Environment-import Control.Exception (bracket)-import System.Posix.Directory (changeWorkingDirectory)+import Control.Exception (bracket, try, SomeException) import Text.Show.Pretty-import qualified Github.Data.Definitions as Github+import Control.Monad.State.Strict+import qualified Github.Data.Readable as Github import qualified Github.Repos as Github import qualified Github.Repos.Forks as Github import qualified Github.PullRequests as Github@@ -21,6 +26,7 @@ import qualified Github.Issues.Milestones  import Common+import Utility.State import qualified Git import qualified Git.Construct import qualified Git.Config@@ -28,69 +34,212 @@ import qualified Git.Command import qualified Git.Ref import qualified Git.Branch-import qualified Git.Queue -usage :: String-usage = "usage: github-backup [directory]"--getLocalRepo :: [String] -> IO Git.Repo-getLocalRepo [] = Git.Construct.fromCwd-getLocalRepo (d:[]) = Git.Construct.fromPath d-getLocalRepo _ = error usage- -- A github user and repo. data GithubUserRepo = GithubUserRepo String String--instance Show (GithubUserRepo) where-	show (GithubUserRepo user remote) = "git://github.com/" ++ user ++ "/" ++ remote ++ ".git"+	deriving (Eq, Show, Read, Ord)  toGithubUserRepo :: Github.Repo -> GithubUserRepo toGithubUserRepo r = GithubUserRepo  	(Github.githubUserLogin $ Github.repoOwner r) 	(Github.repoName r) -remoteFor :: Github.Repo -> String-remoteFor r = "github_" ++-	(Github.githubUserLogin $ Github.repoOwner r) ++ "_" ++-	(Github.repoName r)+repoUrl :: GithubUserRepo -> String+repoUrl (GithubUserRepo user remote) =+	"git://github.com/" ++ user ++ "/" ++ remote ++ ".git" -showRepo :: Github.Repo -> String-showRepo = show . toGithubUserRepo+repoWikiUrl :: GithubUserRepo -> String+repoWikiUrl (GithubUserRepo user remote) =+	"git://github.com/" ++ user ++ "/" ++ remote ++ ".wiki.git" -runRepoWith :: (String -> String -> b -> IO (Either Github.Error v)) -> b -> Github.Repo -> IO (Maybe v)-runRepoWith a b = run (\user repo -> a user repo b) . toGithubUserRepo+-- A name for a github api call.+type ApiName = String -runRepo :: (String -> String -> IO (Either Github.Error v)) -> Github.Repo -> IO (Maybe v)-runRepo a = run a . toGithubUserRepo+-- A request to make of github. It may have an extra parameter.+data Request = RequestSimple ApiName GithubUserRepo+	| RequestNum ApiName GithubUserRepo Int+	deriving (Eq, Show, Read, Ord) -run :: (String -> String -> IO (Either Github.Error v)) -> GithubUserRepo -> IO (Maybe v)-run a r@(GithubUserRepo user repo) = handle =<< a user repo+requestRepo :: Request -> GithubUserRepo+requestRepo (RequestSimple _ repo) = repo+requestRepo (RequestNum _ repo _) = repo++requestName :: Request -> String+requestName (RequestSimple name _) = name+requestName (RequestNum name _ _) = name++data BackupState = BackupState+	{ failedRequests :: S.Set Request+	, retriedRequests :: S.Set Request+	, backupRepo :: Git.Repo+	}++{- Our monad. -}+newtype Backup a = Backup { runBackup :: StateT BackupState IO a }+	deriving (+		Monad,+		MonadState BackupState,+		MonadIO,+		Functor,+		Applicative+	)++inRepo :: (Git.Repo -> IO a) -> Backup a+inRepo a = liftIO . a =<< getState backupRepo++failedRequest :: Request -> Github.Error-> Backup ()+failedRequest req e = unless (ignorable e) $ do+	set <- getState failedRequests+	changeState $ \s -> s { failedRequests = S.insert req set } 	where-		handle (Right v) = return $ Just v-		handle (Left e) = do-			hPutStrLn stderr $ "problem accessing API for " ++ show r ++ ": " ++ show e-			return Nothing+		ignorable (Github.JsonError m) =+			"disabled for this repo" `isInfixOf` m+		ignorable _ = False -{- Finds already configured remotes that use github.- - Fetches from them because it would be surprising if a github backup- - didn't do so, and this is the only place the remote names are available. -}-gitHubRemotes :: Git.Repo -> IO [Github.Repo]-gitHubRemotes r = do-	let (repos, remotes) = unzip  $ gitHubUserRepos r-	when (null remotes) $ error "no github remotes found"-	forM_ repos $ \repo ->-		Git.Command.runBool "fetch" [Param $ fromJust $ Git.Types.remoteName repo] r-	catMaybes <$> mapM (run Github.userRepo) remotes+runRequest :: Request -> Backup ()+runRequest req = do+	-- avoid re-running requests that were already retried+	retried <- getState retriedRequests+	unless (S.member req retried) $+		(lookupApi req) req -gitHubUserRepos :: Git.Repo -> [(Git.Repo, GithubUserRepo)]-gitHubUserRepos = mapMaybe check . Git.Types.remotes+type Storer = Request -> Backup ()+data ApiListItem = ApiListItem ApiName Storer Bool+apiList :: [ApiListItem]+apiList = +	[ ApiListItem "userrepo" userrepoStore True+	, ApiListItem "watchers" watchersStore True+	, ApiListItem "pullrequests" pullrequestsStore True+	, ApiListItem "pullrequest" pullrequestStore False+	, ApiListItem "milestones" milestonesStore True+	, ApiListItem "issues" issuesStore True+	, ApiListItem "issuecomments" issuecommentsStore False+	-- comes last because it recurses on to the forks+	, ApiListItem "forks" forksStore True+	]++{- Map of Github api calls we can make to store their data. -}+api :: M.Map ApiName Storer+api = M.fromList $ map (\(ApiListItem n s _) -> (n, s)) apiList++{- List of toplevel api calls that are followed to get all data. -}+toplevelApi :: [ApiName]+toplevelApi = map (\(ApiListItem n _ _) -> n) $+	filter (\(ApiListItem _ _ toplevel) -> toplevel) apiList++lookupApi :: Request -> Storer+lookupApi req = fromMaybe bad $ M.lookup name api 	where+		name = requestName req+		bad = error $ "internal error: bad api call: " ++ name++userrepoStore :: Storer+userrepoStore = simpleHelper Github.userRepo $ \req r -> do+	when (Github.repoHasWiki r == Just True) $+		updateWiki $ toGithubUserRepo r+	store "repo" req r++watchersStore :: Storer+watchersStore = simpleHelper Github.watchersFor $ storeSorted "watchers"++pullrequestsStore :: Storer+pullrequestsStore = simpleHelper Github.pullRequestsFor $+	forValues $ \req r -> do+		let repo = requestRepo req+		let n = Github.pullRequestNumber r+		runRequest $ RequestNum "pullrequest" repo n++pullrequestStore :: Storer+pullrequestStore = numHelper Github.pullRequest $ \n ->+	store ("pullrequest" </> show n)++milestonesStore :: Storer+milestonesStore = simpleHelper Github.Issues.Milestones.milestones $+	forValues $ \req m -> do+		let n = Github.milestoneNumber m+		store ("milestone" </> show n) req m++issuesStore :: Storer+issuesStore = withHelper Github.issuesForRepo [] $ forValues $ \req i -> do+	let repo = requestRepo req+	let n = Github.issueNumber i+	store ("issue" </> show n) req i+	runRequest (RequestNum "issuecomments" repo n)++issuecommentsStore :: Storer+issuecommentsStore = numHelper Github.Issues.Comments.comments $ \n ->+	forValues $ \req c -> do+		let i = Github.issueCommentId c+		store ("issue" </> show n ++ "_comment" </> show i) req c++forksStore :: Storer+forksStore = simpleHelper Github.forksFor $ \req fs -> do+	storeSorted "forks" req fs+	mapM_ (traverse . toGithubUserRepo) fs+	where+		traverse fork = whenM (addFork fork) $+			gatherMetaData fork++forValues :: (Request -> v -> Backup ()) -> Request -> [v] -> Backup ()+forValues handle req vs = forM_ vs (handle req)++type ApiCall v = String -> String -> IO (Either Github.Error v)+type ApiWith v b = String -> String -> b -> IO (Either Github.Error v)+type ApiNum v = ApiWith v Int+type Handler v = Request -> v -> Backup ()+type Helper = Request -> Backup ()++simpleHelper :: ApiCall v -> Handler v -> Helper+simpleHelper call handle req@(RequestSimple _ (GithubUserRepo user repo)) =+	either (failedRequest req) (handle req) =<< liftIO (call user repo)+simpleHelper _ _ r = badRequest r++withHelper :: ApiWith v b -> b -> Handler v -> Helper+withHelper call b handle req@(RequestSimple _ (GithubUserRepo user repo)) =+	either (failedRequest req) (handle req) =<< liftIO (call user repo b)+withHelper _ _ _ r = badRequest r++numHelper :: ApiNum v -> (Int -> Handler v) -> Helper+numHelper call handle req@(RequestNum _ (GithubUserRepo user repo) num) =+	either (failedRequest req) (handle num req) =<< liftIO (call user repo num)+numHelper _ _ r = badRequest r++badRequest :: Request -> a+badRequest r = error $ "internal error: bad request type " ++ show r++store :: Show a => FilePath -> Request -> a -> Backup ()+store filebase req val = do+	file <- location (requestRepo req) <$> workDir+	liftIO $ do+		createDirectoryIfMissing True (parentDir file)+		writeFile file (ppShow val)+	where+		location (GithubUserRepo user repo) workdir =+			workdir </> user ++ "_" ++ repo </> filebase++workDir :: Backup FilePath+workDir = (</>)+		<$> (Git.gitDir <$> getState backupRepo)+		<*> pure "github-backup.tmp"++storeSorted :: Ord a => Show a => FilePath -> Request -> [a] -> Backup ()+storeSorted file req val = store file req (sort val)++gitHubRepos :: Backup [Git.Repo]+gitHubRepos = fst . unzip . gitHubPairs <$> getState backupRepo++gitHubRemotes :: Backup [GithubUserRepo]+gitHubRemotes = snd . unzip . gitHubPairs <$> getState backupRepo++gitHubPairs :: Git.Repo -> [(Git.Repo, GithubUserRepo)]+gitHubPairs = filter (not . wiki ) . mapMaybe check . Git.Types.remotes+	where 		check r@Git.Repo { Git.Types.location = Git.Types.Url u } = 			headMaybe $ mapMaybe (checkurl r $ show u) gitHubUrlPrefixes 		check _ = Nothing 		checkurl r u prefix 			| prefix `isPrefixOf` u && length bits == 2 =-				Just $ (r,+				Just (r, 					GithubUserRepo (bits !! 0) 						(dropdotgit $ bits !! 1)) 			| otherwise = Nothing@@ -100,6 +249,7 @@ 		dropdotgit s 			| ".git" `isSuffixOf` s = take (length s - length ".git") s 			| otherwise = s+		wiki (_, GithubUserRepo _ u) = ".wiki" `isSuffixOf` u  {- All known prefixes for urls to github repos. -} gitHubUrlPrefixes :: [String]@@ -111,133 +261,209 @@ 	, "ssh://git@github.com/~/" 	] -{- Recursively look for forks, and forks of forks, of the repos.- - Note that this guards against cycles in the fork tree, although- - presumably that should never happen. -}-findForks :: [Github.Repo] -> IO [Github.Repo]-findForks = findForks' []-findForks' :: [Github.Repo] -> [Github.Repo] -> IO [Github.Repo]-findForks' _ [] = return []-findForks' done rs = do-	forks <- filter new . concat . catMaybes <$>-		mapM (runRepo Github.forksFor) rs-	forks' <- findForks' (done++rs) forks-	return $ nub $ forks ++ forks'-	where-		new r = not $ r `elem` rs || r `elem` done--{- Adds new forks, fetching from them. -}-addForks :: Git.Repo -> [Github.Repo] -> IO ()-addForks _ [] = putStrLn "no new forks"-addForks r forks = do -	putStrLn $ "new forks: " ++ unwords (map showRepo forks)-	forM_ forks $ \fork -> do-		Git.Command.runBool "remote"-			[ Param "add"-			, Param "-f"-			, Param $ remoteFor fork-			, Param $ Github.repoGitUrl fork-			] r- onGithubBranch :: Git.Repo -> IO () -> IO () onGithubBranch r a = bracket prep cleanup (const a) 	where 		prep = do 			oldbranch <- Git.Branch.current r-			exists <- Git.Ref.matching (Git.Ref $ "refs/heads/" ++ branchname) r+			when (oldbranch == Just branchref) $+				error $ "it's not currently safe to run github-backup while the " +++					branchname ++ " branch is checked out!"+			exists <- Git.Ref.matching branchref r 			if null exists-				then Git.Command.run "checkout"-					[Param "--orphan", Param branchname] r-				else Git.Command.run "checkout"-					[Param branchname] r+				then checkout [Param "--orphan", Param branchname]+				else checkout [Param branchname] 			return oldbranch 		cleanup Nothing = return () 		cleanup (Just oldbranch) 			| name == branchname = return ()-			| otherwise = Git.Command.run "checkout" [Param name] r+			| otherwise = checkout [Param "--force", Param name] 			where 				name = show $ Git.Ref.base oldbranch+		checkout params = Git.Command.run "checkout" (Param "-q" : params) r 		branchname = "github"+		branchref = Git.Ref $ "refs/heads/" ++ branchname -commitFiles :: Git.Repo -> [FilePath] -> IO ()-commitFiles _ [] = return ()-commitFiles r files = do-	mass "add" [Param "-f"]-	mass "commit" [Param "-m", Param "github-backup"]-	where-		mass subcommand params = do-			let q = Git.Queue.add Git.Queue.new subcommand params files-			_ <- Git.Queue.flush q r+{- Commits all files in the workDir into git, and deletes it. -}+commitWorkDir :: Backup ()+commitWorkDir = do+	dir <- workDir+	r <- getState backupRepo+	let git_false_worktree ps = boolSystem "git" $+		[ Param ("--work-tree=" ++ dir)+		, Param ("--git-dir=" ++ Git.gitDir r)+		] ++ ps+	liftIO $ whenM (doesDirectoryExist dir) $ onGithubBranch r $ do+		_ <- git_false_worktree [ Param "add", Param "." ]+		_ <- git_false_worktree [ Param "commit",+			 Param "-a", Param "-m", Param "github-backup"]+		removeDirectoryRecursive dir++updateWiki :: GithubUserRepo -> Backup ()+updateWiki fork = do+	remotes <- Git.remotes <$> getState backupRepo+	if any (\r -> Git.remoteName r == Just remote) remotes+		then do+			_ <- fetchwiki 			return ()+		else do+			-- github often does not really have a wiki,+			-- don't bloat config if there is none+			unlessM (addRemote remote $ repoWikiUrl fork) $+				removeRemote remote+			return ()+	where+		fetchwiki = inRepo $ Git.Command.runBool "fetch" [Param remote]+		remote = remoteFor fork+		remoteFor (GithubUserRepo user repo) =+			"github_" ++ user ++ "_" ++ repo ++ ".wiki" -saveMetaData :: Show a => Github.Repo -> String -> a -> IO FilePath-saveMetaData repo file val = do-	let file' = remoteFor repo </> file-	createDirectoryIfMissing True (parentDir file')-	writeFile file' (ppShow val)-	return file'+addFork :: GithubUserRepo -> Backup Bool+addFork fork = do+	remotes <- gitHubRemotes+	if fork `elem` remotes+		then return False+		else do+			liftIO $ putStrLn $ "New fork: " ++ repoUrl fork+			_ <- addRemote (remoteFor fork) (repoUrl fork)+			return True+	where+		remoteFor (GithubUserRepo user repo) =+			"github_" ++ user ++ "_" ++ repo -gatherMetaData :: Github.Repo -> IO [FilePath]-gatherMetaData repo = do-	putStrLn $ "gathering metadata for " ++ showRepo repo-	concat <$> mapM (\a -> a repo)-		[ pullRequests-		, watchers-		, issues-		, milestones+{- Adds a remote, also fetching from it. -}+addRemote :: String -> String -> Backup Bool+addRemote remotename remoteurl =+	inRepo $ Git.Command.runBool "remote"+		[ Param "add"+		, Param "-f"+		, Param remotename+		, Param remoteurl 		] -pullRequests :: Github.Repo -> IO [FilePath]-pullRequests repo = runRepo Github.pullRequestsFor repo >>= collect-	where-		collect Nothing = return []-		collect (Just rs) = forM rs $ \r -> do-			let n = Github.pullRequestNumber r-			details <- runRepoWith Github.pullRequest n repo-			saveMetaData repo ("pullrequest" </> show n) details+removeRemote :: String -> Backup ()+removeRemote remotename = do+	_ <- inRepo $ Git.Command.runBool "remote"+		[ Param "rm"+		, Param remotename+		]+	return () -watchers :: Github.Repo -> IO [FilePath]-watchers repo = runRepo Github.watchersFor repo >>= collect-	where-		collect Nothing = return []-		collect (Just ws) = do-			f <- saveMetaData repo "watchers" $ sort ws-			return [f]+{- Fetches from the github remote. Done by github-backup, just because+ - it would be weird for a backup to not fetch all available data.+ - Even though its real focus is on metadata not stored in git. -}+fetchRepo :: Git.Repo -> Backup Bool+fetchRepo repo = inRepo $+	Git.Command.runBool "fetch"+		[Param $ fromJust $ Git.Types.remoteName repo] -issues :: Github.Repo -> IO [FilePath]-issues repo = runRepoWith Github.issuesForRepo [] repo >>= collect+{- Gathers metadata for the repo. Retuns a list of files written+ - and a list that may contain requests that need to be retried later. -}+gatherMetaData :: GithubUserRepo -> Backup ()+gatherMetaData repo = do+	liftIO $ putStrLn $ "Gathering metadata for " ++ repoUrl repo ++ " ..."+	mapM_ call toplevelApi 	where-		collect Nothing = return []-		collect (Just is) = concat <$> forM is get-		get i = do-			let n = Github.issueNumber i-			f <- saveMetaData repo ("issue" </> show n) i-			fs <- issueComments n repo-			return $ f:fs+		call name = runRequest $ RequestSimple name repo -issueComments :: Int -> Github.Repo -> IO [FilePath]-issueComments n repo = runRepoWith Github.Issues.Comments.comments n repo >>= collect+storeRetry :: [Request] -> Git.Repo -> IO ()+storeRetry [] r = do+	_ <- try $ removeFile (retryFile r) :: IO (Either SomeException ()) +	return ()+storeRetry retryrequests r = writeFile (retryFile r) (show retryrequests)++loadRetry :: Git.Repo -> IO [Request]+loadRetry r = maybe [] (fromMaybe [] . readish)+	<$> catchMaybeIO (readFileStrict (retryFile r))++retryFile :: Git.Repo -> FilePath+retryFile r = Git.gitDir r </> "github-backup.todo"++retry :: Backup (S.Set Request)+retry = do+	todo <- inRepo loadRetry+	unless (null todo) $ do+		liftIO $ putStrLn $+			"Retrying " ++ show (length todo) +++			" requests that failed last time..."+		mapM_ runRequest todo+	retriedfailed <- getState failedRequests+	changeState $ \s -> s+		{ failedRequests = S.empty+		, retriedRequests = S.fromList todo+		}+	return retriedfailed++summarizeRequests :: [Request] -> [String]+summarizeRequests = go M.empty 	where-		collect Nothing = return []-		collect (Just cs) = forM cs $ \c -> do-			let i = Github.issueCommentId c-			saveMetaData repo ("issue" </> show n ++ "_comment" </> show i) c+		go m [] = map format $ sort $ map swap $ M.toList m+		go m (r:rs) = go (M.insertWith (+) (requestName r) (1 :: Integer) m) rs+		format (num, name) = show num ++ "\t" ++ name+		swap (a, b) = (b, a) -milestones :: Github.Repo -> IO [FilePath]-milestones repo = runRepo Github.Issues.Milestones.milestones repo >>= collect+{- Save all backup data. Files that were written to the workDir are committed.+ - Requests that failed are saved for next time. Requests that were retried+ - this time and failed are ordered last, to ensure that we don't get stuck+ - retrying the same requests and not making progress when run again.+ -}+save :: S.Set Request -> Backup ()+save retriedfailed = do+	commitWorkDir+	failed <- getState failedRequests+	let toretry = S.toList failed ++ S.toList retriedfailed+	inRepo $ storeRetry toretry+	unless (null toretry) $+		error $ unlines $+			["Backup may be incomplete; " ++ +				show (length toretry) ++ " requests failed:"+			] ++ map ("  " ++) (summarizeRequests toretry) ++ +			[ "Run again later."+			]++newState :: Git.Repo -> BackupState+newState = BackupState S.empty S.empty++backup :: Git.Repo -> IO ()+backup repo = evalStateT (runBackup go) . newState =<< Git.Config.read repo 	where-		collect Nothing = return []-		collect (Just ms) = forM ms $ \m -> do-			let n = Github.milestoneNumber m-			saveMetaData repo ("milestone" </> show n) m+		go = do+			retriedfailed <- retry+			remotes <- gitHubPairs <$> getState backupRepo+			when (null remotes) $+				error "no github remotes found"+			forM_ remotes $ \(r, remote) -> do+				_ <- fetchRepo r+				gatherMetaData remote+			save retriedfailed +backupUser :: String -> IO ()+backupUser username = do+	repos <- either (error . show) id <$>+		Github.userRepos username Github.All+	when (null repos) $+		error $ "No GitHub repositories found for user " ++ username+	status <- forM repos $ \repo -> do+		let dir = Github.repoName repo+		unlessM (doesDirectoryExist dir) $ do+			putStrLn $ "New repository: " ++ dir+			ok <- boolSystem "git"+				[ Param "clone"+				, Param (Github.repoGitUrl repo)+				, Param dir+				]+			unless ok $ error "clone failed"+		try (backup =<< Git.Construct.fromPath dir)+			:: IO (Either SomeException ())+	unless (null $ lefts status) $+		error "Failed to successfully back everything up. Run again later."++usage :: String+usage = "usage: github-backup [username]"+ main :: IO ()-main = do-	r <- Git.Config.read =<< getLocalRepo =<< getArgs-	changeWorkingDirectory $ Git.repoLocation r-	remotes <- gitHubRemotes r-	forks <- findForks remotes-	addForks r forks-	onGithubBranch r $-		concat <$> forM (forks ++ remotes) gatherMetaData-			>>= commitFiles r+main = getArgs >>= go+	where+		go [] = backup =<< Git.Construct.fromCwd+		go (username:[]) = backupUser username+		go _= error usage