diff --git a/Build/Configure.hs b/Build/Configure.hs --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -4,7 +4,6 @@ module Build.Configure where -import System.Environment import Control.Applicative import Control.Monad.IfElse @@ -25,7 +24,6 @@ run :: [TestCase] -> IO () run ts = do - args <- getArgs config <- runTests ts writeSysConfig config whenM (isReleaseBuild) $ diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,15 @@ +github-backup (1.20171126) unstable; urgency=medium + + * Updated to use github-0.18 + * Pull requests retreived with authentication again. + * Build with -threaded, which fixes some issues with the non-threaded + GHC RTS. + * Removed dependency on MissingH, instead depending on split. + * Various updates to internal git and utility libraries shared + with git-annex. + + -- Joey Hess Sun, 26 Nov 2017 15:33:35 -0400 + github-backup (1.20170301) unstable; urgency=medium * No longer hosted on Github due to their horrible new TOS. diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -9,7 +9,6 @@ import Data.Maybe as X import Data.List as X hiding (head, tail, init, last) -import Data.String.Utils as X hiding (join) import System.FilePath as X import System.IO as X hiding (FilePath) @@ -29,5 +28,6 @@ import Utility.Monad as X import Utility.Data as X import Utility.Applicative as X +import Utility.Split as X import Utility.PartialPrelude as X diff --git a/Git/CatFile.hs b/Git/CatFile.hs --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -26,7 +26,6 @@ import qualified Data.Map as M import Data.String import Data.Char -import Data.Tuple.Utils import Numeric import System.Posix.Types @@ -38,6 +37,7 @@ import Git.FilePath import qualified Utility.CoProcess as CoProcess import Utility.FileSystemEncoding +import Utility.Tuple data CatFileHandle = CatFileHandle { catFileProcess :: CoProcess.CoProcessHandle diff --git a/Git/Command.hs b/Git/Command.hs --- a/Git/Command.hs +++ b/Git/Command.hs @@ -91,16 +91,16 @@ pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool) pipeNullSplit params repo = do (s, cleanup) <- pipeReadLazy params repo - return (filter (not . null) $ split sep s, cleanup) + return (filter (not . null) $ splitc sep s, cleanup) where - sep = "\0" + sep = '\0' pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String] pipeNullSplitStrict params repo = do s <- pipeReadStrict params repo - return $ filter (not . null) $ split sep s + return $ filter (not . null) $ splitc sep s where - sep = "\0" + sep = '\0' pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String] pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo diff --git a/Git/Config.hs b/Git/Config.hs --- a/Git/Config.hs +++ b/Git/Config.hs @@ -132,7 +132,7 @@ -- --list output will have an = in the first line | all ('=' `elem`) (take 1 ls) = sep '=' ls -- --null --list output separates keys from values with newlines - | otherwise = sep '\n' $ split "\0" s + | otherwise = sep '\n' $ splitc '\0' s where ls = lines s sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) . diff --git a/Git/Construct.hs b/Git/Construct.hs --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -26,7 +26,7 @@ #ifndef mingw32_HOST_OS import System.Posix.User #endif -import qualified Data.Map as M hiding (map, split) +import qualified Data.Map as M import Network.URI import Common @@ -94,7 +94,7 @@ fromUrlStrict :: String -> IO Repo fromUrlStrict url - | startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u + | "file://" `isPrefixOf` url = fromAbsPath $ unEscapeString $ uriPath u | otherwise = pure $ newFrom $ Url u where u = fromMaybe bad $ parseURI url @@ -128,7 +128,7 @@ filterconfig f = filter f $ M.toList $ config repo filterkeys f = filterconfig (\(k,_) -> f k) remotepairs = filterkeys isremote - isremote k = startswith "remote." k && endswith ".url" k + isremote k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo {- Sets the name of a remote when constructing the Repo to represent it. -} @@ -143,7 +143,7 @@ remoteNamedFromKey k = remoteNamed basename where basename = intercalate "." $ - reverse $ drop 1 $ reverse $ drop 1 $ split "." k + reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} diff --git a/Git/Ref.hs b/Git/Ref.hs --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -45,6 +45,10 @@ underBase :: String -> Ref -> Ref underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r) +{- Convert a branch such as "master" into a fully qualified ref. -} +branchRef :: Branch -> Ref +branchRef = underBase "refs/heads" + {- A Ref that can be used to refer to a file in the repository, as staged - in the index. - @@ -101,7 +105,7 @@ matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo -{- List of (shas, branches) matching a given ref or refs. -} +{- List of (shas, branches) matching a given ref spec. -} matching' :: [String] -> Repo -> IO [(Sha, Branch)] matching' ps repo = map gen . lines <$> pipeReadStrict (Param "show-ref" : map Param ps) repo @@ -109,17 +113,36 @@ gen l = let (r, b) = separate (== ' ') l in (Ref r, Ref b) -{- List of (shas, branches) matching a given ref spec. +{- List of (shas, branches) matching a given ref. - Duplicate shas are filtered out. -} matchingUniq :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingUniq refs repo = nubBy uniqref <$> matching refs repo where uniqref (a, _) (b, _) = a == b +{- List of all refs. -} +list :: Repo -> IO [(Sha, Ref)] +list = matching' [] + +{- Deletes a ref. This can delete refs that are not branches, + - which git branch --delete refuses to delete. -} +delete :: Sha -> Ref -> Repo -> IO () +delete oldvalue ref = run + [ Param "update-ref" + , Param "-d" + , Param $ fromRef ref + , Param $ fromRef oldvalue + ] + {- Gets the sha of the tree a ref uses. -} tree :: Ref -> Repo -> IO (Maybe Sha) -tree ref = extractSha <$$> pipeReadStrict - [ Param "rev-parse", Param (fromRef ref ++ ":") ] +tree (Ref ref) = extractSha <$$> pipeReadStrict + [ Param "rev-parse", Param ref' ] + where + ref' = if ":" `isInfixOf` ref + then ref + -- de-reference commit objects to the tree + else ref ++ ":" {- Checks if a String is a legal git ref name. - @@ -144,6 +167,6 @@ ends v = v `isSuffixOf` s begins v = v `isPrefixOf` s - pathbits = split "/" s + pathbits = splitc '/' s illegalchars = " ~^:?*[\\" ++ controlchars controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)] diff --git a/Git/Remote.hs b/Git/Remote.hs --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -74,9 +74,9 @@ (bestkey, bestvalue) = maximumBy longestvalue insteadofs longestvalue (_, a) (_, b) = compare b a insteadofs = filterconfig $ \(k, v) -> - startswith prefix k && - endswith suffix k && - startswith v l + prefix `isPrefixOf` k && + suffix `isSuffixOf` k && + v `isPrefixOf` l filterconfig f = filter f $ concatMap splitconfigs $ M.toList $ fullconfig repo splitconfigs (k, vs) = map (\v -> (k, v)) vs diff --git a/Github/EnumRepos.hs b/Github/EnumRepos.hs --- a/Github/EnumRepos.hs +++ b/Github/EnumRepos.hs @@ -4,11 +4,10 @@ import qualified GitHub.Data.Definitions as Github import qualified GitHub.Data.Name as Github import Data.List -import Data.List.Utils import Data.Maybe import qualified Data.Text as T -import Utility.PartialPrelude +import Common import qualified Git import qualified Git.Types diff --git a/Utility/Directory.hs b/Utility/Directory.hs --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -16,6 +16,7 @@ import System.IO.Error import Control.Monad import System.FilePath +import System.PosixCompat.Files import Control.Applicative import Control.Concurrent import System.IO.Unsafe (unsafeInterleaveIO) @@ -31,7 +32,6 @@ #endif import Utility.SystemDirectory -import Utility.PosixFiles import Utility.Tmp import Utility.Exception import Utility.Monad @@ -96,10 +96,10 @@ go c (dir:dirs) | skipdir (takeFileName dir) = go c dirs | otherwise = unsafeInterleaveIO $ do - subdirs <- go c + subdirs <- go [] =<< filterM (isDirectory <$$> getSymbolicLinkStatus) =<< catchDefaultIO [] (dirContents dir) - go (subdirs++[dir]) dirs + go (subdirs++dir:c) dirs {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs --- a/Utility/DottedVersion.hs +++ b/Utility/DottedVersion.hs @@ -25,7 +25,7 @@ normalize :: String -> DottedVersion normalize v = DottedVersion v $ sum $ mult 1 $ reverse $ extend precision $ take precision $ - map readi $ split "." v + map readi $ splitc '.' v where extend n l = l ++ replicate (n - length l) 0 mult _ [] = [] diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -1,6 +1,6 @@ {- File mode utilities. - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2017 Joey Hess - - License: BSD-2-clause -} @@ -15,7 +15,7 @@ import System.IO import Control.Monad import System.PosixCompat.Types -import Utility.PosixFiles +import System.PosixCompat.Files #ifndef mingw32_HOST_OS import System.Posix.Files import Control.Monad.IO.Class (liftIO) @@ -130,6 +130,21 @@ withUmask _ a = a #endif +getUmask :: IO FileMode +#ifndef mingw32_HOST_OS +getUmask = bracket setup cleanup return + where + setup = setFileCreationMask nullFileMode + cleanup = setFileCreationMask +#else +getUmask = return nullFileMode +#endif + +defaultFileMode :: IO FileMode +defaultFileMode = do + umask <- getUmask + return $ intersectFileModes (complement umask) stdFileMode + combineModes :: [FileMode] -> FileMode combineModes [] = 0 combineModes [m] = m @@ -162,7 +177,10 @@ (\h -> hPutStr h content) writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO () -writeFileProtected' file writer = withUmask 0o0077 $ +writeFileProtected' file writer = protectedOutput $ withFile file WriteMode $ \h -> do void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes writer h + +protectedOutput :: IO a -> IO a +protectedOutput = withUmask 0o0077 diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -10,8 +10,8 @@ module Utility.FileSystemEncoding ( useFileSystemEncoding, + fileEncoding, withFilePath, - md5FilePath, decodeBS, encodeBS, decodeW8, @@ -19,6 +19,10 @@ encodeW8NUL, decodeW8NUL, truncateFilePath, + s2w8, + w82s, + c2w8, + w82c, ) where import qualified GHC.Foreign as GHC @@ -26,17 +30,15 @@ import Foreign.C import System.IO import System.IO.Unsafe -import qualified Data.Hash.MD5 as MD5 import Data.Word -import Data.Bits.Utils import Data.List -import Data.List.Utils import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS import qualified Data.ByteString.Lazy.UTF8 as L8 #endif import Utility.Exception +import Utility.Split {- Makes all subsequent Handles that are opened, as well as stdio Handles, - use the filesystem encoding, instead of the encoding of the current @@ -63,6 +65,13 @@ hSetEncoding stderr e Encoding.setLocaleEncoding e +fileEncoding :: Handle -> IO () +#ifndef mingw32_HOST_OS +fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding +#else +fileEncoding h = hSetEncoding h Encoding.utf8 +#endif + {- Marshal a Haskell FilePath into a NUL terminated C string using temporary - storage. The FilePath is encoded using the filesystem encoding, - reversing the decoding that should have been done when the FilePath @@ -93,10 +102,6 @@ GHC.withCString enc fp (GHC.peekCString Encoding.char8) `catchNonAsync` (\_ -> return fp) -{- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -} -md5FilePath :: FilePath -> MD5.Str -md5FilePath = MD5.Str . _encodeFilePath - {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -} decodeBS :: L.ByteString -> FilePath #ifndef mingw32_HOST_OS @@ -137,14 +142,26 @@ {- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -} encodeW8NUL :: [Word8] -> FilePath -encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul) +encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul) where - nul = ['\NUL'] + nul = '\NUL' decodeW8NUL :: FilePath -> [Word8] -decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul +decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul where - nul = ['\NUL'] + nul = '\NUL' + +c2w8 :: Char -> Word8 +c2w8 = fromIntegral . fromEnum + +w82c :: Word8 -> Char +w82c = toEnum . fromIntegral + +s2w8 :: String -> [Word8] +s2w8 = map c2w8 + +w82s :: [Word8] -> String +w82s = map w82c {- Truncates a FilePath to the given number of bytes (or less), - as represented on disk. diff --git a/Utility/Misc.hs b/Utility/Misc.hs --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -112,7 +112,7 @@ peekbytes :: Int -> Ptr Word8 -> IO [Word8] peekbytes len buf = mapM (peekElemOff buf) [0..pred len] -{- Reaps any zombie git processes. +{- Reaps any zombie processes that may be hanging around. - - Warning: Not thread safe. Anything that was expecting to wait - on a process and get back an exit status is going to be confused diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs --- a/Utility/PartialPrelude.hs +++ b/Utility/PartialPrelude.hs @@ -2,7 +2,7 @@ - bugs. - - This exports functions that conflict with the prelude, which avoids - - them being accidentially used. + - them being accidentally used. -} {-# OPTIONS_GHC -fno-warn-tabs #-} diff --git a/Utility/Path.hs b/Utility/Path.hs --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -10,7 +10,6 @@ module Utility.Path where -import Data.String.Utils import System.FilePath import Data.List import Data.Maybe @@ -25,10 +24,10 @@ import Utility.Exception #endif -import qualified "MissingH" System.Path as MissingH import Utility.Monad import Utility.UserInfo import Utility.Directory +import Utility.Split {- Simplifies a path, removing any "." component, collapsing "dir/..", - and removing the trailing path separator. @@ -68,18 +67,6 @@ absPathFrom :: FilePath -> FilePath -> FilePath absPathFrom dir path = simplifyPath (combine dir path) -{- On Windows, this converts the paths to unix-style, in order to run - - MissingH's absNormPath on them. -} -absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath -#ifndef mingw32_HOST_OS -absNormPathUnix dir path = MissingH.absNormPath dir path -#else -absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path) - where - fromdos = replace "\\" "/" - todos = replace "/" "\\" -#endif - {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -} parentDir :: FilePath -> FilePath parentDir = takeDirectory . dropTrailingPathSeparator @@ -89,12 +76,13 @@ upFrom :: FilePath -> Maybe FilePath upFrom dir | length dirs < 2 = Nothing - | otherwise = Just $ joinDrive drive (intercalate s $ init dirs) + | otherwise = Just $ joinDrive drive $ intercalate s $ init dirs where - -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" + -- on Unix, the drive will be "/" when the dir is absolute, + -- otherwise "" (drive, path) = splitDrive dir - dirs = filter (not . null) $ split s path s = [pathSeparator] + dirs = filter (not . null) $ split s path prop_upFrom_basics :: FilePath -> Bool prop_upFrom_basics dir @@ -148,17 +136,22 @@ -} relPathDirToFileAbs :: FilePath -> FilePath -> FilePath relPathDirToFileAbs from to - | takeDrive from /= takeDrive to = to - | otherwise = intercalate s $ dotdots ++ uncommon +#ifdef mingw32_HOST_OS + | normdrive from /= normdrive to = to +#endif + | otherwise = joinPath $ dotdots ++ uncommon where - s = [pathSeparator] - pfrom = split s from - pto = split s to + pfrom = sp from + pto = sp to + sp = map dropTrailingPathSeparator . splitPath . dropDrive common = map fst $ takeWhile same $ zip pfrom pto same (c,d) = c == d uncommon = drop numcommon pto dotdots = replicate (length pfrom - numcommon) ".." numcommon = length common +#ifdef mingw32_HOST_OS + normdrive = map toLower . takeWhile (/= ':') . takeDrive +#endif prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool prop_relPathDirToFile_basics from to @@ -227,6 +220,8 @@ - - The command may be fully qualified already, in which case it will - be returned if it exists. + - + - Note that this will find commands in PATH that are not executable. -} searchPath :: String -> IO (Maybe FilePath) searchPath command diff --git a/Utility/Process.hs b/Utility/Process.hs --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -174,22 +174,21 @@ -- returns a transcript combining its stdout and stderr, and -- whether it succeeded or failed. processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) -processTranscript = processTranscript' id +processTranscript cmd opts = processTranscript' (proc cmd opts) -processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool) -processTranscript' modproc cmd opts input = do +processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool) +processTranscript' cp input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} (readf, writef) <- System.Posix.IO.createPipe readh <- System.Posix.IO.fdToHandle readf writeh <- System.Posix.IO.fdToHandle writef - p@(_, _, _, pid) <- createProcess $ modproc $ - (proc cmd opts) - { std_in = if isJust input then CreatePipe else Inherit - , std_out = UseHandle writeh - , std_err = UseHandle writeh - } + p@(_, _, _, pid) <- createProcess $ cp + { std_in = if isJust input then CreatePipe else Inherit + , std_out = UseHandle writeh + , std_err = UseHandle writeh + } hClose writeh get <- mkreader readh @@ -200,12 +199,11 @@ return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} - p@(_, _, _, pid) <- createProcess $ modproc $ - (proc cmd opts) - { std_in = if isJust input then CreatePipe else Inherit - , std_out = CreatePipe - , std_err = CreatePipe - } + p@(_, _, _, pid) <- createProcess $ cp + { std_in = if isJust input then CreatePipe else Inherit + , std_out = CreatePipe + , std_err = CreatePipe + } getout <- mkreader (stdoutHandle p) geterr <- mkreader (stderrHandle p) diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -11,7 +11,7 @@ import System.Exit import Utility.Process -import Data.String.Utils +import Utility.Split import System.FilePath import Data.Char import Data.List @@ -86,7 +86,7 @@ shellEscape f = "'" ++ escaped ++ "'" where -- replace ' with '"'"' - escaped = intercalate "'\"'\"'" $ split "'" f + escaped = intercalate "'\"'\"'" $ splitc '\'' f -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String] diff --git a/Utility/Split.hs b/Utility/Split.hs new file mode 100644 --- /dev/null +++ b/Utility/Split.hs @@ -0,0 +1,30 @@ +{- split utility functions + - + - Copyright 2017 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Split where + +import Data.List (intercalate) +import Data.List.Split (splitOn) + +-- | same as Data.List.Utils.split +-- +-- intercalate x . splitOn x === id +split :: Eq a => [a] -> [a] -> [[a]] +split = splitOn + +-- | Split on a single character. This is over twice as fast as using +-- split on a list of length 1, while producing identical results. -} +splitc :: Eq c => c -> [c] -> [[c]] +splitc c s = case break (== c) s of + (i, _c:rest) -> i : splitc c rest + (i, []) -> i : [] + +-- | same as Data.List.Utils.replace +replace :: Eq a => [a] -> [a] -> [a] -> [a] +replace old new = intercalate new . split old diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -15,20 +15,20 @@ import System.FilePath import System.Directory import Control.Monad.IO.Class +import System.PosixCompat.Files #ifndef mingw32_HOST_OS import System.Posix.Temp (mkdtemp) #endif import Utility.Exception import Utility.FileSystemEncoding -import Utility.PosixFiles type Template = String {- Runs an action like writeFile, writing to a temp file first and - then moving it into place. The temp file is stored in the same - directory as the final file to avoid cross-device renames. -} -viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m () +viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m () viaTmp a file content = bracketIO setup cleanup use where (dir, base) = splitFileName file diff --git a/Utility/Tuple.hs b/Utility/Tuple.hs new file mode 100644 --- /dev/null +++ b/Utility/Tuple.hs @@ -0,0 +1,17 @@ +{- tuple utility functions + - + - Copyright 2017 Joey Hess + - + - License: BSD-2-clause + -} + +module Utility.Tuple where + +fst3 :: (a,b,c) -> a +fst3 (a,_,_) = a + +snd3 :: (a,b,c) -> b +snd3 (_,b,_) = b + +thd3 :: (a,b,c) -> c +thd3 (_,_,c) = c diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -15,11 +15,13 @@ ) where import Utility.Env -import Utility.Data import Utility.Exception +#ifndef mingw32_HOST_OS +import Utility.Data +import Control.Applicative +#endif import System.PosixCompat -import Control.Applicative import Prelude {- Current user's home directory. @@ -58,6 +60,7 @@ #ifndef mingw32_HOST_OS go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID) #else - go [] = return $ Left ("environment not set: " ++ show envvars) + go [] = return $ either Left (Right . extract) $ + Left ("environment not set: " ++ show envvars) #endif go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v diff --git a/github-backup.cabal b/github-backup.cabal --- a/github-backup.cabal +++ b/github-backup.cabal @@ -1,5 +1,5 @@ Name: github-backup -Version: 1.20170301 +Version: 1.20171126 Cabal-Version: >= 1.8 Maintainer: Joey Hess Author: Joey Hess @@ -36,13 +36,13 @@ Executable github-backup Main-Is: github-backup.hs - GHC-Options: -Wall -fno-warn-tabs + GHC-Options: -Wall -fno-warn-tabs -threaded 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 + github (>= 0.18 && < 0.19), + text, filepath, exceptions, transformers, bytestring, vector, + hslogger, split, process, containers, unix-compat, IfElse, + directory, mtl, utf8-string, optparse-applicative, pretty-show if (! os(windows)) Build-Depends: unix @@ -81,6 +81,7 @@ Git.Sha Git.Remote Utility.Tmp + Utility.Tuple Utility.Path Utility.FileSystemEncoding Utility.Monad @@ -100,6 +101,7 @@ Utility.DottedVersion Utility.Applicative Utility.Directory + Utility.Split Utility.SystemDirectory Executable gitriddance @@ -107,10 +109,10 @@ GHC-Options: -Wall -fno-warn-tabs 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 + github (>= 0.18 && < 0.19), + text, filepath, exceptions, transformers, bytestring, vector, + hslogger, split, process, containers, unix-compat, IfElse, + directory, mtl, utf8-string if (! os(windows)) Build-Depends: unix @@ -122,8 +124,40 @@ else Build-Depends: network (< 2.6), network (>= 2.0) + Other-Modules: + Common + Git + Git.Command + Git.Config + Git.Construct + Git.FilePath + Git.Remote + Git.Types + Git.Url + Github.EnumRepos + Github.GetAuth + Utility.Applicative + Utility.CoProcess + Utility.Data + Utility.Directory + Utility.Env + Utility.Exception + Utility.FileMode + Utility.FileSystemEncoding + Utility.Misc + Utility.Monad + Utility.PartialPrelude + Utility.Path + Utility.Process + Utility.Process.Shim + Utility.SafeCommand + Utility.Split + Utility.SystemDirectory + Utility.Tmp + Utility.UserInfo + custom-setup - Setup-Depends: base (>= 4.5), hslogger, MissingH, directory, process, + Setup-Depends: base (>= 4.5), hslogger, split, directory, process, unix-compat, unix, exceptions, bytestring, filepath, IfElse, mtl, Cabal source-repository head diff --git a/github-backup.hs b/github-backup.hs --- a/github-backup.hs +++ b/github-backup.hs @@ -157,9 +157,7 @@ storeSorted "stargazers" pullrequestsStore :: Storer -pullrequestsStore = simpleHelper "pullrequest" - -- No way to send auth to pullRequestsFor currently. - (\_auth -> Github.pullRequestsFor) $ +pullrequestsStore = simpleHelper "pullrequest" Github.pullRequestsFor' $ forValues $ \req r -> do let repo = requestRepo req let n = Github.simplePullRequestNumber r diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,7 @@ packages: - '.' -resolver: lts-8.2 -extra-deps: [] +extra-deps: + - IfElse-0.85 +explicit-setup-deps: + github-backup: true +resolver: nightly-2017-11-25