make GIT_DIR, GIT_WORK_TREE absolute
GIT_DIR is set to something relative, like ".git" in the pre-commit hook. But internally all the directories are assumed to be absolute.
This commit is contained in:
		
					parent
					
						
							
								eb6cb1b87f
							
						
					
				
			
			
				commit
				
					
						a1885bd116
					
				
			
		
					 2 changed files with 6 additions and 5 deletions
				
			
		| 
						 | 
					@ -29,20 +29,22 @@ import qualified Git.Config
 | 
				
			||||||
 -}
 | 
					 -}
 | 
				
			||||||
get :: IO Repo
 | 
					get :: IO Repo
 | 
				
			||||||
get = do
 | 
					get = do
 | 
				
			||||||
	gd <- takeenv "GIT_DIR"
 | 
						gd <- pathenv "GIT_DIR"
 | 
				
			||||||
	r <- configure gd =<< maybe fromCwd fromPath gd
 | 
						r <- configure gd =<< maybe fromCwd fromPath gd
 | 
				
			||||||
	wt <- maybe (worktree $ location r) Just <$> takeenv "GIT_WORK_TREE"
 | 
						wt <- maybe (worktree $ location r) Just <$> pathenv "GIT_WORK_TREE"
 | 
				
			||||||
	case wt of
 | 
						case wt of
 | 
				
			||||||
		Nothing -> return r
 | 
							Nothing -> return r
 | 
				
			||||||
		Just d -> do
 | 
							Just d -> do
 | 
				
			||||||
			changeWorkingDirectory d
 | 
								changeWorkingDirectory d
 | 
				
			||||||
			return $ addworktree wt r
 | 
								return $ addworktree wt r
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		takeenv s = do
 | 
							pathenv s = do
 | 
				
			||||||
			v <- getEnv s
 | 
								v <- getEnv s
 | 
				
			||||||
			when (isJust v) $
 | 
								when (isJust v) $
 | 
				
			||||||
				unsetEnv s
 | 
									unsetEnv s
 | 
				
			||||||
			return v
 | 
								case v of
 | 
				
			||||||
 | 
									Nothing -> return Nothing
 | 
				
			||||||
 | 
									Just d -> Just <$> absPath d
 | 
				
			||||||
		configure Nothing r = Git.Config.read r
 | 
							configure Nothing r = Git.Config.read r
 | 
				
			||||||
		configure (Just d) r = do
 | 
							configure (Just d) r = do
 | 
				
			||||||
			r' <- Git.Config.read r
 | 
								r' <- Git.Config.read r
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										1
									
								
								test.hs
									
										
									
									
									
								
							
							
						
						
									
										1
									
								
								test.hs
									
										
									
									
									
								
							| 
						 | 
					@ -25,7 +25,6 @@ import qualified Utility.SafeCommand
 | 
				
			||||||
import qualified Annex
 | 
					import qualified Annex
 | 
				
			||||||
import qualified Annex.UUID
 | 
					import qualified Annex.UUID
 | 
				
			||||||
import qualified Backend
 | 
					import qualified Backend
 | 
				
			||||||
import qualified Git.Config
 | 
					 | 
				
			||||||
import qualified Git.CurrentRepo
 | 
					import qualified Git.CurrentRepo
 | 
				
			||||||
import qualified Git.Filename
 | 
					import qualified Git.Filename
 | 
				
			||||||
import qualified Locations
 | 
					import qualified Locations
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue