github-backup 1.20161118 → 1.20170221

raw patch · 19 files changed

+87/−81 lines, 19 filesdep ~basedep ~github

Dependency ranges changed: base, github

Files

• CHANGELOG +10/−0
• Common.hs +0/−1
• Git/CatFile.hs +1/−0
• Git/Command.hs +1/−5
• Git/Config.hs +0/−5
• Git/HashObject.hs +0/−1
• Git/Queue.hs +0/−1
• Git/UpdateIndex.hs +0/−1
• README.md +2/−2
• Utility/CoProcess.hs +3/−3
• Utility/Exception.hs +17/−1
• Utility/FileSystemEncoding.hs +22/−19
• Utility/Misc.hs +0/−17
• Utility/SystemDirectory.hs +1/−1
• Utility/UserInfo.hs +2/−1
• github-backup.cabal +13/−9
• github-backup.hs +12/−11
• gitriddance.hs +2/−2
• stack.yaml +1/−1

@@ -1,3 +1,13 @@+github-backup (1.20170221) unstable; urgency=medium++  * Updated to use github-0.15.+  * Due to a regression in github-0.15, the pull request list is retrieved+    without authentication.+  * Various updates to internal git and utility libraries shared+    with git-annex.++ -- Joey Hess <id@joeyh.name>  Tue, 21 Feb 2017 15:33:56 -0400+ github-backup (1.20161118) unstable; urgency=medium    * Fix build with recent versions of cabal.

@@ -29,6 +29,5 @@ import Utility.Monad as X import Utility.Data as X import Utility.Applicative as X-import Utility.FileSystemEncoding as X  import Utility.PartialPrelude as X

@@ -37,6 +37,7 @@ import Git.Types import Git.FilePath import qualified Utility.CoProcess as CoProcess+import Utility.FileSystemEncoding  data CatFileHandle = CatFileHandle  	{ catFileProcess :: CoProcess.CoProcessHandle

@@ -53,7 +53,6 @@ pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool) pipeReadLazy params repo = assertLocal repo $ do 	(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }-	fileEncoding h 	c <- hGetContents h 	return (c, checkSuccessProcess pid)   where@@ -66,7 +65,6 @@ pipeReadStrict :: [CommandParam] -> Repo -> IO String pipeReadStrict params repo = assertLocal repo $ 	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do-		fileEncoding h 		output <- hGetContentsStrict h 		hClose h 		return output@@ -81,9 +79,7 @@ 	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo)  		(gitEnv repo) writer (Just adjusthandle)   where-	adjusthandle h = do-		fileEncoding h-		hSetNewlineMode h noNewlineTranslation+	adjusthandle h = hSetNewlineMode h noNewlineTranslation  {- Runs a git command, feeding it input on a handle with an action. -} pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()

@@ -79,10 +79,6 @@ {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo hRead repo h = do-	-- We use the FileSystemEncoding when reading from git-config,-	-- because it can contain arbitrary filepaths (and other strings)-	-- in any encoding.-	fileEncoding h 	val <- hGetContentsStrict h 	store val repo @@ -167,7 +163,6 @@ fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String)) fromPipe r cmd params = try $ 	withHandle StdoutHandle createProcessSuccess p $ \h -> do-		fileEncoding h 		val <- hGetContentsStrict h 		r' <- store val r 		return (r', val)

@@ -41,7 +41,6 @@  - interface does not allow batch hashing without using temp files. -} hashBlob :: HashObjectHandle -> String -> IO Sha hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do-	fileEncoding tmph #ifdef mingw32_HOST_OS 	hSetNewlineMode tmph noNewlineTranslation #endif

@@ -159,7 +159,6 @@ #ifndef mingw32_HOST_OS 	let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo } 	withHandle StdinHandle createProcessSuccess p $ \h -> do-		fileEncoding h 		hPutStr h $ intercalate "\0" $ toCommand $ getFiles action 		hClose h #else

@@ -55,7 +55,6 @@ startUpdateIndex repo = do 	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo) 		{ std_in = CreatePipe }-	fileEncoding h 	return $ UpdateIndexHandle p h   where 	params = map Param ["update-index", "-z", "--index-info"]

@@ -10,9 +10,9 @@  	sudo apt-get install haskell-stack -Then to build and install github-backup:+Then to build and install github-backup, clone it, cd inside, and run: -	stack install github-backup+	stack install  There is also a Makefile, which uses cabal to build, and installs a man page, bash completion file, etc. This is recommended for use when

@@ -47,10 +47,10 @@ 	rawMode to 	return $ CoProcessState pid to from s   where-	rawMode h = do-		fileEncoding h #ifdef mingw32_HOST_OS-		hSetNewlineMode h noNewlineTranslation+	rawMode h = hSetNewlineMode h noNewlineTranslation+#else+	rawMode _ = return () #endif  stop :: CoProcessHandle -> IO ()

@@ -1,6 +1,6 @@ {- Simple IO exception handling (and some more)  -- - Copyright 2011-2015 Joey Hess <id@joeyh.name>+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -10,6 +10,7 @@  module Utility.Exception ( 	module X,+	giveup, 	catchBoolIO, 	catchMaybeIO, 	catchDefaultIO,@@ -39,6 +40,21 @@ import GHC.IO.Exception (IOErrorType(..))  import Utility.Data++{- Like error, this throws an exception. Unlike error, if this exception+ - is not caught, it won't generate a backtrace. So use this for situations+ - where there's a problem that the user is excpected to see in some+ - circumstances. -}+giveup :: [Char] -> a+#ifdef MIN_VERSION_base+#if MIN_VERSION_base(4,9,0)+giveup = errorWithoutStackTrace+#else+giveup = error+#endif+#else+giveup = error+#endif  {- Catches IO errors and returns a Bool -} catchBoolIO :: MonadCatch m => m Bool -> m Bool

@@ -1,6 +1,6 @@ {- GHC File system encoding handling.  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -9,7 +9,7 @@ {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.FileSystemEncoding (-	fileEncoding,+	useFileSystemEncoding, 	withFilePath, 	md5FilePath, 	decodeBS,@@ -19,7 +19,6 @@ 	encodeW8NUL, 	decodeW8NUL, 	truncateFilePath,-	setConsoleEncoding, ) where  import qualified GHC.Foreign as GHC@@ -39,19 +38,30 @@  import Utility.Exception -{- Sets a Handle to use the filesystem encoding. This causes data- - written or read from it to be encoded/decoded the same- - as ghc 7.4 does to filenames etc. This special encoding- - allows "arbitrary undecodable bytes to be round-tripped through it".+{- Makes all subsequent Handles that are opened, as well as stdio Handles,+ - use the filesystem encoding, instead of the encoding of the current+ - locale.+ -+ - The filesystem encoding allows "arbitrary undecodable bytes to be+ - round-tripped through it". This avoids encoded failures when data is not+ - encoded matching the current locale.+ -+ - Note that code can still use hSetEncoding to change the encoding of a+ - Handle. This only affects the default encoding.  -}-fileEncoding :: Handle -> IO ()+useFileSystemEncoding :: IO ()+useFileSystemEncoding = do #ifndef mingw32_HOST_OS-fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding+	e <- Encoding.getFileSystemEncoding #else-{- The file system encoding does not work well on Windows,- - and Windows only has utf FilePaths anyway. -}-fileEncoding h = hSetEncoding h Encoding.utf8+	{- The file system encoding does not work well on Windows,+	 - and Windows only has utf FilePaths anyway. -}+	let e = Encoding.utf8 #endif+	hSetEncoding stdin e+	hSetEncoding stdout e+	hSetEncoding stderr e+	Encoding.setLocaleEncoding e	  {- Marshal a Haskell FilePath into a NUL terminated C string using temporary  - storage. The FilePath is encoded using the filesystem encoding,@@ -165,10 +175,3 @@ 					else go (c:coll) (cnt - x') (L8.drop 1 bs) 			_ -> coll #endif--{- This avoids ghc's output layer crashing on invalid encoded characters in- - filenames when printing them out. -}-setConsoleEncoding :: IO ()-setConsoleEncoding = do-	fileEncoding stdout-	fileEncoding stderr

@@ -10,9 +10,6 @@  module Utility.Misc where -import Utility.FileSystemEncoding-import Utility.Monad- import System.IO import Control.Monad import Foreign@@ -34,20 +31,6 @@ {- A version of readFile that is not lazy. -} readFileStrict :: FilePath -> IO String readFileStrict = readFile >=> \s -> length s `seq` return s--{-  Reads a file strictly, and using the FileSystemEncoding, so it will- -  never crash on a badly encoded file. -}-readFileStrictAnyEncoding :: FilePath -> IO String-readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do-	fileEncoding h-	hClose h `after` hGetContentsStrict h--{- Writes a file, using the FileSystemEncoding so it will never crash- - on a badly encoded content string. -}-writeFileAnyEncoding :: FilePath -> String -> IO ()-writeFileAnyEncoding f content = withFile f WriteMode $ \h -> do-	fileEncoding h-	hPutStr h content  {- Like break, but the item matching the condition is not included  - in the second result list.

@@ -13,4 +13,4 @@ 	module System.Directory ) where -import System.Directory hiding (isSymbolicLink)+import System.Directory hiding (isSymbolicLink, getFileSize)

@@ -16,6 +16,7 @@  import Utility.Env import Utility.Data+import Utility.Exception  import System.PosixCompat import Control.Applicative@@ -25,7 +26,7 @@  -  - getpwent will fail on LDAP or NIS, so use HOME if set. -} myHomeDir :: IO FilePath-myHomeDir = either error return =<< myVal env homeDirectory+myHomeDir = either giveup return =<< myVal env homeDirectory   where #ifndef mingw32_HOST_OS 	env = ["HOME"]

@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20161118+Version: 1.20170221 Cabal-Version: >= 1.8 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -37,11 +37,12 @@ Executable github-backup   Main-Is: github-backup.hs   GHC-Options: -Wall -fno-warn-tabs-  Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl,-   network, exceptions, transformers, unix-compat, bytestring, vector,-   IfElse, pretty-show, text, process, optparse-applicative, utf8-string,-   github >= 0.14.0 && < 0.15.0,-   base >= 4.8, base < 5+  Build-Depends:+    base (>= 4.8 && < 5),+    github (>= 0.15.0 && < 0.16.0),+    MissingH, hslogger, directory, filepath, containers, mtl,+    network, exceptions, transformers, unix-compat, bytestring, vector,+    IfElse, pretty-show, text, process, optparse-applicative, utf8-string      if (! os(windows))     Build-Depends: unix@@ -104,9 +105,12 @@ Executable gitriddance   Main-Is: gitriddance.hs   GHC-Options: -Wall -fno-warn-tabs-  Build-Depends: github >= 0.14.0 && < 0.15.0, base >= 4.8, base < 5, text, filepath,-    MissingH, exceptions, transformers, bytestring, vector, hslogger, process,-    containers, unix-compat, IfElse, directory, mtl, utf8-string+  Build-Depends: +    base (>= 4.8 && < 5),+    github (>= 0.15.0 && < 0.16.0),+    text, filepath, MissingH, exceptions, transformers, bytestring, vector,+    hslogger, process, containers, unix-compat, IfElse, directory, mtl,+    utf8-string      if (! os(windows))     Build-Depends: unix

@@ -52,6 +52,7 @@ import Git.CatFile import Git.Index import Utility.Env+import Utility.FileSystemEncoding  repoUrl :: GithubUserRepo -> String repoUrl (GithubUserRepo user remote) =@@ -156,7 +157,9 @@ 	storeSorted "stargazers"  pullrequestsStore :: Storer-pullrequestsStore = simpleHelper "pullrequest" Github.pullRequestsFor' $+pullrequestsStore = simpleHelper "pullrequest"+	-- No way to send auth to pullRequestsFor currently.+	(\_auth -> Github.pullRequestsFor) $ 	forValues $ \req r -> do 		let repo = requestRepo req 		let n = Github.simplePullRequestNumber r@@ -178,14 +181,9 @@ 		store ("milestone" </> show n) req m  issuesStore :: Storer-issuesStore = withHelper "issue" (\a u r y ->-	Github.issuesForRepo' a (fromString u) (fromString r) (y <> [Github.Open])-		>>= either (return . Left)-			(\xs -> Github.issuesForRepo' a (fromString u) (fromString r)-				(y <> [Github.OnlyClosed])-					>>= either (return . Left)-						(\ys -> return (Right (xs <> ys)))))-	[Github.PerPage 100] go+issuesStore = withHelper "issue"+	(\a u r -> Github.issuesForRepo' a (fromString u) (fromString r))+	Github.stateAll go   where 	go = forValues $ \req i -> do 		let repo = requestRepo req@@ -567,9 +565,10 @@   where 	excludeurls = map repoUrl exclude 	+	makenameurl :: Github.Repo -> Maybe (String, String) 	makenameurl repo =  		case Github.repoGitUrl repo of-			Just url -> Just (T.unpack $ Github.untagName $ Github.repoName repo, T.unpack url)+			Just url -> Just (T.unpack $ Github.untagName $ Github.repoName repo, T.unpack $ Github.getUrl url) 			Nothing -> Nothing  	prepare (dir, url)@@ -618,7 +617,9 @@ 	in GithubUserRepo user repo  main :: IO ()-main = execParser opts >>= go+main = do+	useFileSystemEncoding+	execParser opts >>= go   where 	opts = info (helper <*> options) 		( fullDesc

@@ -48,7 +48,7 @@ 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.Open]+		=<< Github.issuesForRepo' (Just auth) (fromString user) (fromString repo) Github.stateOpen   where 	oops action err = error $ "failed " ++ action ++ ": " ++ show err 	close issue = do@@ -58,4 +58,4 @@ 			=<< Github.createComment auth (fromString user) (fromString repo) (Github.mkId (Github.Id 0) i) (T.pack msg) 		either (oops "closing issue/pull") (const $ return ()) 			=<< Github.editIssue auth (fromString user) (fromString repo) (Github.mkId (Github.Id 0) i)-				(Github.editOfIssue { Github.editIssueState = Just (T.pack "closed") } )+				(Github.editOfIssue { Github.editIssueState = Just Github.StateClosed } )

@@ -1,4 +1,4 @@ packages: - '.'-resolver: lts-6.12+resolver: lts-8.2 extra-deps: []