diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Branch.hs | 7 | ||||
| -rw-r--r-- | Git/BuildVersion.hs | 2 | ||||
| -rw-r--r-- | Git/CatFile.hs | 4 | ||||
| -rw-r--r-- | Git/Command.hs | 4 | ||||
| -rw-r--r-- | Git/Config.hs | 24 | ||||
| -rw-r--r-- | Git/Construct.hs | 21 | ||||
| -rw-r--r-- | Git/CurrentRepo.hs | 6 | ||||
| -rw-r--r-- | Git/DiffTreeItem.hs | 2 | ||||
| -rw-r--r-- | Git/FilePath.hs | 5 | ||||
| -rw-r--r-- | Git/Filename.hs | 2 | ||||
| -rw-r--r-- | Git/Fsck.hs | 2 | ||||
| -rw-r--r-- | Git/Index.hs | 2 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 19 | ||||
| -rw-r--r-- | Git/LsTree.hs | 2 | ||||
| -rw-r--r-- | Git/Objects.hs | 2 | ||||
| -rw-r--r-- | Git/Ref.hs | 5 | ||||
| -rw-r--r-- | Git/RefLog.hs | 19 | ||||
| -rw-r--r-- | Git/Remote.hs | 2 | ||||
| -rw-r--r-- | Git/Repair.hs | 15 | ||||
| -rw-r--r-- | Git/Sha.hs | 2 | ||||
| -rw-r--r-- | Git/Types.hs | 2 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 2 | ||||
| -rw-r--r-- | Git/Url.hs | 2 | ||||
| -rw-r--r-- | Git/Version.hs | 2 |
24 files changed, 88 insertions, 67 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs index 5c6135d..a2225dc 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -1,6 +1,6 @@ {- git branch stuff - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -37,15 +37,12 @@ current r = do {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine - <$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r + <$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r where parse l | null l = Nothing | otherwise = Just $ Git.Ref l -currentSha :: Repo -> IO (Maybe Git.Sha) -currentSha r = maybe (pure Nothing) (`Git.Ref.sha` r) =<< current r - {- Checks if the second branch has any commits not present on the first - branch. -} changed :: Branch -> Branch -> Repo -> IO Bool diff --git a/Git/BuildVersion.hs b/Git/BuildVersion.hs index 832ee8a..50e4a3a 100644 --- a/Git/BuildVersion.hs +++ b/Git/BuildVersion.hs @@ -1,6 +1,6 @@ {- git build version - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/CatFile.hs b/Git/CatFile.hs index d0bcef4..c63a064 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -1,6 +1,6 @@ {- git cat-file interface - - - Copyright 2011, 2013 Joey Hess <joey@kitenet.net> + - Copyright 2011, 2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -110,4 +110,4 @@ catTree h treeref = go <$> catObjectDetails h treeref parsemodefile b = let (modestr, file) = separate (== ' ') (decodeBS b) in (file, readmode modestr) - readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct + readmode = fromMaybe 0 . fmap fst . headMaybe . readOct diff --git a/Git/Command.hs b/Git/Command.hs index c61cc9f..02e3e5a 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -1,6 +1,6 @@ {- running git commands - - - Copyright 2010-2013 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,7 +16,7 @@ import qualified Utility.CoProcess as CoProcess {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] -gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) = +gitCommandLine params r@(Repo { location = l@(Local { } ) }) = setdir : settree ++ gitGlobalOpts r ++ params where setdir = Param $ "--git-dir=" ++ gitdir l diff --git a/Git/Config.hs b/Git/Config.hs index 32c0dd1..3d62395 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -1,6 +1,6 @@ {- git repository configuration handling - - - Copyright 2010-2012 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,6 +14,7 @@ import Common import Git import Git.Types import qualified Git.Construct +import qualified Git.Command import Utility.UserInfo {- Returns a single git config setting, or a default value if not set. -} @@ -66,10 +67,9 @@ global = do home <- myHomeDir ifM (doesFileExist $ home </> ".gitconfig") ( do - repo <- Git.Construct.fromUnknown - repo' <- withHandle StdoutHandle createProcessSuccess p $ - hRead repo - return $ Just repo' + repo <- withHandle StdoutHandle createProcessSuccess p $ + hRead (Git.Construct.fromUnknown) + return $ Just repo , return Nothing ) where @@ -194,3 +194,17 @@ changeFile f k v = boolSystem "git" , Param k , Param v ] + +{- Unsets a git config setting, in both the git repo, + - and the cached config in the Repo. + - + - If unsetting the config fails, including in a read-only repo, or + - when the config is not set, returns Nothing. + -} +unset :: String -> Repo -> IO (Maybe Repo) +unset k r = ifM (Git.Command.runBool ps r) + ( return $ Just $ r { config = M.delete k (config r) } + , return Nothing + ) + where + ps = [Param "config", Param "--unset-all", Param k] diff --git a/Git/Construct.hs b/Git/Construct.hs index 3c6013a..5b20605 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -1,6 +1,6 @@ {- Construction of Git Repo objects - - - Copyright 2010-2012 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -19,8 +19,8 @@ module Git.Construct ( fromRemotes, fromRemoteLocation, repoAbsPath, - newFrom, checkForRepo, + newFrom, ) where #ifndef mingw32_HOST_OS @@ -45,10 +45,10 @@ fromCwd = getCurrentDirectory >>= seekUp seekUp dir = do r <- checkForRepo dir case r of - Nothing -> case parentDir dir of + Nothing -> case upFrom dir of Nothing -> return Nothing Just d -> seekUp d - Just loc -> Just <$> newFrom loc + Just loc -> pure $ Just $ newFrom loc {- Local Repo constructor, accepts a relative or absolute path. -} fromPath :: FilePath -> IO Repo @@ -62,7 +62,7 @@ fromAbsPath dir | otherwise = error $ "internal error, " ++ dir ++ " is not absolute" where - ret = newFrom . LocalUnknown + ret = pure . newFrom . LocalUnknown {- Git always looks for "dir.git" in preference to - to "dir", even if dir ends in a "/". -} canondir = dropTrailingPathSeparator dir @@ -90,13 +90,13 @@ fromUrl url fromUrlStrict :: String -> IO Repo fromUrlStrict url | startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u - | otherwise = newFrom $ Url u + | otherwise = pure $ newFrom $ Url u where u = fromMaybe bad $ parseURI url bad = error $ "bad url " ++ url {- Creates a repo that has an unknown location. -} -fromUnknown :: IO Repo +fromUnknown :: Repo fromUnknown = newFrom Unknown {- Converts a local Repo into a remote repo, using the reference repo @@ -153,7 +153,7 @@ fromRemoteLocation s repo = gen $ parseRemoteLocation s repo fromRemotePath :: FilePath -> Repo -> IO Repo fromRemotePath dir repo = do dir' <- expandTilde dir - fromAbsPath $ repoPath repo </> dir' + fromPath $ repoPath repo </> dir' {- Git remotes can have a directory that is specified relative - to the user's home directory, or that contains tilde expansions. @@ -223,8 +223,8 @@ checkForRepo dir = gitdirprefix = "gitdir: " gitSignature file = doesFileExist $ dir </> file -newFrom :: RepoLocation -> IO Repo -newFrom l = return Repo +newFrom :: RepoLocation -> Repo +newFrom l = Repo { location = l , config = M.empty , fullconfig = M.empty @@ -234,4 +234,3 @@ newFrom l = return Repo , gitGlobalOpts = [] } - diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index f611f7a..dab4ad2 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -1,6 +1,6 @@ {- The current git repository. - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -50,8 +50,8 @@ get = do configure (Just d) _ = do absd <- absPath d curr <- getCurrentDirectory - r <- newFrom $ Local { gitdir = absd, worktree = Just curr } - Git.Config.read r + Git.Config.read $ newFrom $ + Local { gitdir = absd, worktree = Just curr } configure Nothing Nothing = error "Not in a git repository." addworktree w r = changelocation r $ diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs index 2389b69..859f590 100644 --- a/Git/DiffTreeItem.hs +++ b/Git/DiffTreeItem.hs @@ -1,6 +1,6 @@ {- git diff-tree item - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 42eb081..edc3c0f 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -5,7 +5,7 @@ - top of the repository even when run in a subdirectory. Adding some - types helps keep that straight. - - - Copyright 2012-2013 Joey Hess <joey@kitenet.net> + - Copyright 2012-2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -39,8 +39,7 @@ fromTopFilePath p repo = absPathFrom (repoPath repo) (getTopFilePath p) {- The input FilePath can be absolute, or relative to the CWD. -} toTopFilePath :: FilePath -> Git.Repo -> IO TopFilePath -toTopFilePath file repo = TopFilePath <$> - relPathDirToFile (repoPath repo) <$> absPath file +toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file {- The input FilePath must already be relative to the top of the git - repository -} diff --git a/Git/Filename.hs b/Git/Filename.hs index 5e076d3..382eb8d 100644 --- a/Git/Filename.hs +++ b/Git/Filename.hs @@ -1,7 +1,7 @@ {- Some git commands output encoded filenames, in a rather annoyingly complex - C-style encoding. - - - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - Copyright 2010, 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Fsck.hs b/Git/Fsck.hs index c6002f6..f3e6db9 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -1,6 +1,6 @@ {- git fsck interface - - - Copyright 2013 Joey Hess <joey@kitenet.net> + - Copyright 2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Index.hs b/Git/Index.hs index 7145bb9..551fd98 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -1,6 +1,6 @@ {- git index file stuff - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 2aa05ba..e80c1b2 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -1,6 +1,6 @@ {- git ls-files interface - - - Copyright 2010,2012 Joey Hess <joey@kitenet.net> + - Copyright 2010,2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -131,9 +131,9 @@ typeChanged' ps l repo = do (fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo -- git diff returns filenames relative to the top of the git repo; -- convert to filenames relative to the cwd, like git ls-files. - let top = repoPath repo + top <- absPath (repoPath repo) currdir <- getCurrentDirectory - return (map (\f -> relPathDirToFile currdir $ top </> f) fs, cleanup) + return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup) where prefix = [Params "diff --name-only --diff-filter=T -z"] suffix = Param "--" : (if null l then [File "."] else map File l) @@ -181,12 +181,13 @@ parseUnmerged s | otherwise = case words metadata of (rawblobtype:rawsha:rawstage:_) -> do stage <- readish rawstage :: Maybe Int - unless (stage == 2 || stage == 3) $ - fail undefined -- skip stage 1 - blobtype <- readBlobType rawblobtype - sha <- extractSha rawsha - return $ InternalUnmerged (stage == 2) file - (Just blobtype) (Just sha) + if stage /= 2 && stage /= 3 + then Nothing + else do + blobtype <- readBlobType rawblobtype + sha <- extractSha rawsha + return $ InternalUnmerged (stage == 2) file + (Just blobtype) (Just sha) _ -> Nothing where (metadata, file) = separate (== '\t') s diff --git a/Git/LsTree.hs b/Git/LsTree.hs index ca5e323..7ef9518 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -1,6 +1,6 @@ {- git ls-tree interface - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Objects.hs b/Git/Objects.hs index dadd4f5..bda220b 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -1,6 +1,6 @@ {- .git/objects - - - Copyright 2013 Joey Hess <joey@kitenet.net> + - Copyright 2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -1,6 +1,6 @@ {- git ref stuff - - - Copyright 2011-2013 Joey Hess <joey@kitenet.net> + - Copyright 2011-2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -88,6 +88,9 @@ sha branch repo = process <$> showref repo process [] = Nothing process s = Just $ Ref $ firstLine s +headSha :: Repo -> IO (Maybe Sha) +headSha = sha headRef + {- List of (shas, branches) matching a given ref or refs. -} matching :: [Ref] -> Repo -> IO [(Sha, Branch)] matching refs repo = matching' (map fromRef refs) repo diff --git a/Git/RefLog.hs b/Git/RefLog.hs index 98c9d66..7c20047 100644 --- a/Git/RefLog.hs +++ b/Git/RefLog.hs @@ -1,6 +1,6 @@ {- git reflog interface - - - Copyright 2013 Joey Hess <joey@kitenet.net> + - Copyright 2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,9 +14,14 @@ import Git.Sha {- Gets the reflog for a given branch. -} get :: Branch -> Repo -> IO [Sha] -get b = mapMaybe extractSha . lines <$$> pipeReadStrict - [ Param "log" - , Param "-g" - , Param "--format=%H" - , Param (fromRef b) - ] +get = get' [] + +get' :: [CommandParam] -> Branch -> Repo -> IO [Sha] +get' ps b = mapMaybe extractSha . lines <$$> pipeReadStrict ps' + where + ps' = + [ Param "log" + , Param "-g" + , Param "--format=%H" + , Param (fromRef b) + ] ++ ps diff --git a/Git/Remote.hs b/Git/Remote.hs index 156e308..717b540 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -1,6 +1,6 @@ {- git remote stuff - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Repair.hs b/Git/Repair.hs index 5731138..2557e3b 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -1,6 +1,6 @@ {- git repository recovery - - - Copyright 2013-2014 Joey Hess <joey@kitenet.net> + - Copyright 2013-2014 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -225,10 +225,13 @@ badBranches missing r = filterM isbad =<< getAllRefs r - Relies on packed refs being exploded before it's called. -} getAllRefs :: Repo -> IO [Ref] -getAllRefs r = map toref <$> dirContentsRecursive refdir - where - refdir = localGitDir r </> "refs" - toref = Ref . relPathDirToFile (localGitDir r) +getAllRefs r = getAllRefs' (localGitDir r </> "refs") + +getAllRefs' :: FilePath -> IO [Ref] +getAllRefs' refdir = do + let topsegs = length (splitPath refdir) - 1 + let toref = Ref . joinPath . drop topsegs . splitPath + map toref <$> dirContentsRecursive refdir explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile r = do @@ -241,7 +244,7 @@ explodePackedRefsFile r = do where makeref (sha, ref) = do let dest = localGitDir r </> fromRef ref - createDirectoryIfMissing True (takeDirectory dest) + createDirectoryIfMissing True (parentDir dest) unlessM (doesFileExist dest) $ writeFile dest (fromRef sha) @@ -1,6 +1,6 @@ {- git SHA stuff - - - Copyright 2011 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Types.hs b/Git/Types.hs index 838c9e0..bb91a17 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -1,6 +1,6 @@ {- git data types - - - Copyright 2010-2012 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 613596d..55c5b3b 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -1,6 +1,6 @@ {- git-update-index library - - - Copyright 2011-2013 Joey Hess <joey@kitenet.net> + - Copyright 2011-2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -1,6 +1,6 @@ {- git repository urls - - - Copyright 2010, 2011 Joey Hess <joey@kitenet.net> + - Copyright 2010, 2011 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Version.hs b/Git/Version.hs index 73ce2f8..ecd1244 100644 --- a/Git/Version.hs +++ b/Git/Version.hs @@ -1,6 +1,6 @@ {- git versions - - - Copyright 2011, 2013 Joey Hess <joey@kitenet.net> + - Copyright 2011, 2013 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} |