diff options
| -rwxr-xr-x[-rw-r--r--] | Annex/CatFile.hs | 3 | ||||
| -rwxr-xr-x[-rw-r--r--] | Annex/Link.hs | 4 | ||||
| -rwxr-xr-x[-rw-r--r--] | Git/CatFile.hs | 4 | ||||
| -rwxr-xr-x[-rw-r--r--] | Git/FilePath.hs | 26 | ||||
| -rwxr-xr-x[-rw-r--r--] | Git/UpdateIndex.hs | 11 | ||||
| -rwxr-xr-x[-rw-r--r--] | Logs/Presence.hs | 0 |
6 files changed, 40 insertions, 8 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 292d62460..c7c01b40c 100644..100755 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -21,6 +21,7 @@ import qualified Git import qualified Git.CatFile import qualified Annex import Git.Types +import Git.FilePath catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -48,7 +49,7 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle {- From the Sha or Ref of a symlink back to the key. -} catKey :: Ref -> Annex (Maybe Key) catKey ref = do - l <- encodeW8 . L.unpack <$> catObject ref + l <- fromInternalGitPath . encodeW8 . L.unpack <$> catObject ref return $ if isLinkToAnnex l then fileKey $ takeFileName l else Nothing diff --git a/Annex/Link.hs b/Annex/Link.hs index 931836d31..24ec6c7c9 100644..100755 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -18,6 +18,7 @@ import qualified Git.HashObject import qualified Git.UpdateIndex import qualified Annex.Queue import Git.Types +import Git.FilePath type LinkTarget = String @@ -74,7 +75,8 @@ addAnnexLink linktarget file = do {- Injects a symlink target into git, returning its Sha. -} hashSymlink :: LinkTarget -> Annex Sha -hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject linktarget +hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject $ + toInternalGitPath linktarget {- Stages a symlink to the annex, using a Sha of its target. -} stageSymlink :: FilePath -> Sha -> Annex () diff --git a/Git/CatFile.hs b/Git/CatFile.hs index b83241445..5ab10b187 100644..100755 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -23,6 +23,7 @@ import Git import Git.Sha import Git.Command import Git.Types +import Git.FilePath import qualified Utility.CoProcess as CoProcess type CatFileHandle = CoProcess.CoProcessHandle @@ -38,7 +39,8 @@ catFileStop = CoProcess.stop {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString -catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file +catFile h branch file = catObject h $ Ref $ + show branch ++ ":" ++ toInternalGitPath file {- Uses a running git cat-file read the content of an object. - Objects that do not exist will have "" returned. -} diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 6344353d6..c3813fe9e 100644..100755 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -5,16 +5,21 @@ - top of the repository even when run in a subdirectory. Adding some - types helps keep that straight. - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Git.FilePath ( TopFilePath, getTopFilePath, toTopFilePath, asTopFilePath, + InternalGitPath, + toInternalGitPath, + fromInternalGitPath ) where import Common @@ -32,3 +37,22 @@ toTopFilePath file repo = TopFilePath <$> - repository -} asTopFilePath :: FilePath -> TopFilePath asTopFilePath file = TopFilePath file + +{- Git may use a different representation of a path when storing + - it internally. For example, on Windows, git uses '/' to separate paths + - stored in the repository, despite Windows using '\' -} +type InternalGitPath = String + +toInternalGitPath :: FilePath -> InternalGitPath +#ifndef __WINDOWS__ +toInternalGitPath = id +#else +toInternalGitPath = replace "\\" "/" +#endif + +fromInternalGitPath :: InternalGitPath -> FilePath +#ifndef __WINDOWS__ +fromInternalGitPath = id +#else +fromInternalGitPath = replace "/" "\\" +#endif diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index aa65b4429..5d07e2011 100644..100755 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -1,11 +1,11 @@ {- git-update-index library - - - Copyright 2011, 2012 Joey Hess <joey@kitenet.net> + - Copyright 2011-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} module Git.UpdateIndex ( Streamer, @@ -59,13 +59,13 @@ lsTree (Ref x) repo streamer = do - a given file with a given sha. -} updateIndexLine :: Sha -> BlobType -> TopFilePath -> String updateIndexLine sha filetype file = - show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file + show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file {- A streamer that removes a file from the index. -} unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do p <- toTopFilePath file repo - return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ getTopFilePath p + return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p {- A streamer that adds a symlink to the index. -} stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer @@ -75,3 +75,6 @@ stageSymlink file sha repo = do <*> pure SymlinkBlob <*> toTopFilePath file repo return $ pureStreamer line + +indexPath :: TopFilePath -> InternalGitPath +indexPath = toInternalGitPath . getTopFilePath diff --git a/Logs/Presence.hs b/Logs/Presence.hs index ec5cec209..ec5cec209 100644..100755 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs |