fix some build warnings from ghc 9.4.6
It now notices that a RepoLocation may not be Local, in which case pattern matching on Local wouldn't do. However, in these cases, I think it always is a Local. In particular, Git.Config.read is only run on local repos and upgrades LocalUnknown to Local.
This commit is contained in:
parent
784be819b3
commit
e03e907705
2 changed files with 5 additions and 3 deletions
|
@ -260,7 +260,7 @@ adjustGitDirFile :: RepoLocation -> IO RepoLocation
|
||||||
adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc
|
adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc
|
||||||
|
|
||||||
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
|
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
|
||||||
adjustGitDirFile' loc = do
|
adjustGitDirFile' loc@(Local {}) = do
|
||||||
let gd = gitdir loc
|
let gd = gitdir loc
|
||||||
c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd))
|
c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd))
|
||||||
if gitdirprefix `isPrefixOf` c
|
if gitdirprefix `isPrefixOf` c
|
||||||
|
@ -275,7 +275,7 @@ adjustGitDirFile' loc = do
|
||||||
else return Nothing
|
else return Nothing
|
||||||
where
|
where
|
||||||
gitdirprefix = "gitdir: "
|
gitdirprefix = "gitdir: "
|
||||||
|
adjustGitDirFile' _ = error "internal"
|
||||||
|
|
||||||
newFrom :: RepoLocation -> Repo
|
newFrom :: RepoLocation -> Repo
|
||||||
newFrom l = Repo
|
newFrom l = Repo
|
||||||
|
|
|
@ -82,7 +82,9 @@ get = do
|
||||||
r <- Git.Config.read $ (newFrom loc)
|
r <- Git.Config.read $ (newFrom loc)
|
||||||
{ gitDirSpecifiedExplicitly = True }
|
{ gitDirSpecifiedExplicitly = True }
|
||||||
return $ if fromMaybe False (Git.Config.isBare r)
|
return $ if fromMaybe False (Git.Config.isBare r)
|
||||||
then r { location = (location r) { worktree = Nothing } }
|
then case location r of
|
||||||
|
loc'@(Local {}) -> r { location = loc' { worktree = Nothing } }
|
||||||
|
_ -> r
|
||||||
else r
|
else r
|
||||||
configure Nothing Nothing = giveup "Not in a git repository."
|
configure Nothing Nothing = giveup "Not in a git repository."
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue