git-annex/Git/FilePath.hs
Joey Hess c95d0cf7a8 Windows: Fix handling of absolute unix-style git repository paths.
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.
2014-02-08 15:39:04 -04:00

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)