deal with git using / internally, even on DOS

This commit is contained in:
Joey Hess 2013-05-12 17:18:48 -05:00
parent a2f83b28f3
commit 73d2f8b280
6 changed files with 40 additions and 8 deletions

3
Annex/CatFile.hs Normal file → Executable file
View file

@ -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

4
Annex/Link.hs Normal file → Executable file
View file

@ -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 ()

4
Git/CatFile.hs Normal file → Executable file
View file

@ -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. -}

26
Git/FilePath.hs Normal file → Executable file
View file

@ -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

11
Git/UpdateIndex.hs Normal file → Executable file
View file

@ -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

0
Logs/Presence.hs Normal file → Executable file
View file