deal with git using / internally, even on DOS
This commit is contained in:
parent
a2f83b28f3
commit
73d2f8b280
6 changed files with 40 additions and 8 deletions
3
Annex/CatFile.hs
Normal file → Executable file
3
Annex/CatFile.hs
Normal file → Executable 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
4
Annex/Link.hs
Normal file → Executable 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
4
Git/CatFile.hs
Normal file → Executable 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
26
Git/FilePath.hs
Normal file → Executable 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
11
Git/UpdateIndex.hs
Normal file → Executable 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
0
Logs/Presence.hs
Normal file → Executable file
Loading…
Add table
Reference in a new issue