Note that on Windows a remote with a path like /home/foo/bar is interpreted by git as being some screwy relative path (relative to what exactly seems ill-defined -- it seemed relative to C:\Program Files\Git\ in my tests!) So no attempt has been made to handle such a path sanely, just not to crash when encountering it. Note that "C:\\foo" </> "/home/foo/bar" yields /home/foo/bar even though that is not absolute! I don't know what to make of all this, except that I will be very happy when this crock of **** vanishes from the face of the earth.
		
			
				
	
	
		
			78 lines
		
	
	
	
		
			2.1 KiB
			
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			78 lines
		
	
	
	
		
			2.1 KiB
			
		
	
	
	
		
			Haskell
		
	
	
	
	
	
{- git FilePath library
 | 
						|
 -
 | 
						|
 - Different git commands use different types of FilePaths to refer to
 | 
						|
 - files in the repository. Some commands use paths relative to the
 | 
						|
 - 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>
 | 
						|
 -
 | 
						|
 - Licensed under the GNU GPL version 3 or higher.
 | 
						|
 -}
 | 
						|
 | 
						|
{-# LANGUAGE CPP #-}
 | 
						|
 | 
						|
module Git.FilePath (
 | 
						|
	TopFilePath,
 | 
						|
	fromTopFilePath,
 | 
						|
	getTopFilePath,
 | 
						|
	toTopFilePath,
 | 
						|
	asTopFilePath,
 | 
						|
	InternalGitPath,
 | 
						|
	toInternalGitPath,
 | 
						|
	fromInternalGitPath,
 | 
						|
	absoluteGitPath
 | 
						|
) where
 | 
						|
 | 
						|
import Common
 | 
						|
import Git
 | 
						|
 | 
						|
import qualified System.FilePath.Posix
 | 
						|
 | 
						|
{- A FilePath, relative to the top of the git repository. -}
 | 
						|
newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
 | 
						|
	deriving (Show)
 | 
						|
 | 
						|
{- Returns an absolute FilePath. -}
 | 
						|
fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
 | 
						|
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
 | 
						|
 | 
						|
{- The input FilePath must already be relative to the top of the git
 | 
						|
 - repository -}
 | 
						|
asTopFilePath :: FilePath -> TopFilePath
 | 
						|
asTopFilePath file = TopFilePath file
 | 
						|
 | 
						|
{- Git may use a different representation of a path when storing
 | 
						|
 - it internally. 
 | 
						|
 -
 | 
						|
 - On Windows, git uses '/' to separate paths stored in the repository,
 | 
						|
 - despite Windows using '\'.
 | 
						|
 -
 | 
						|
 -}
 | 
						|
type InternalGitPath = String
 | 
						|
 | 
						|
toInternalGitPath :: FilePath -> InternalGitPath
 | 
						|
#ifndef mingw32_HOST_OS
 | 
						|
toInternalGitPath = id
 | 
						|
#else
 | 
						|
toInternalGitPath = replace "\\" "/"
 | 
						|
#endif
 | 
						|
 | 
						|
fromInternalGitPath :: InternalGitPath -> FilePath
 | 
						|
#ifndef mingw32_HOST_OS
 | 
						|
fromInternalGitPath = id
 | 
						|
#else
 | 
						|
fromInternalGitPath = replace "/" "\\"
 | 
						|
#endif
 | 
						|
 | 
						|
{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
 | 
						|
 - so try posix paths.
 | 
						|
 -}
 | 
						|
absoluteGitPath :: FilePath -> Bool
 | 
						|
absoluteGitPath p = isAbsolute p ||
 | 
						|
	System.FilePath.Posix.isAbsolute (toInternalGitPath p)
 |