summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-06 14:26:15 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-06 14:26:15 -0400
commit91db54076964979b6c50bd7efd0b895c4d416978 (patch)
tree7ba67f302dac7ef03b2cef906ab08bb88c0f8967
parent993e6459a38817a9062aafae7552a668c2db7a31 (diff)
add support for staging other types of blobs, like symlinks, into the index
Also added a utility TopFilePath type, which could stand to be used more widely.
-rw-r--r--Git/FilePath.hs34
-rw-r--r--Git/Types.hs8
-rw-r--r--Git/UnionMerge.hs3
-rw-r--r--Git/UpdateIndex.hs15
4 files changed, 53 insertions, 7 deletions
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
new file mode 100644
index 000000000..6344353d6
--- /dev/null
+++ b/Git/FilePath.hs
@@ -0,0 +1,34 @@
+{- 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 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.FilePath (
+ TopFilePath,
+ getTopFilePath,
+ toTopFilePath,
+ asTopFilePath,
+) where
+
+import Common
+import Git
+
+{- A FilePath, relative to the top of the git repository. -}
+newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
+
+{- 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
diff --git a/Git/Types.hs b/Git/Types.hs
index 64d418a04..1df6e343b 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -63,3 +63,11 @@ readObjectType "commit" = Just CommitObject
readObjectType "tree" = Just TreeObject
readObjectType _ = Nothing
+{- Types of blobs. -}
+data BlobType = FileBlob | ExecutableBlob | SymlinkBlob
+
+{- Git uses magic numbers to denote the type of a blob. -}
+instance Show BlobType where
+ show FileBlob = "100644"
+ show ExecutableBlob = "100755"
+ show SymlinkBlob = "120000"
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index 822e6abbf..f65b59c53 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -22,6 +22,7 @@ import Git.Command
import Git.UpdateIndex
import Git.HashObject
import Git.Types
+import Git.FilePath
{- Performs a union merge between two branches, staging it in the index.
- Any previously staged changes in the index will be lost.
@@ -79,7 +80,7 @@ mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
[_colonmode, _bmode, asha, bsha, _status] = words info
getcontents s = map L.unpack . L.lines .
L.decodeUtf8 <$> catObject h s
- use sha = return $ Just $ update_index_line sha file
+ use sha = return $ Just $ update_index_line sha FileBlob $ asTopFilePath file
{- Calculates a union merge between a list of refs, with contents.
-
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 04bc4da5b..8c003dd13 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -8,15 +8,17 @@
module Git.UpdateIndex (
Streamer,
stream_update_index,
+ ls_tree,
update_index_line,
- ls_tree
) where
import System.Cmd.Utils
import Common
import Git
+import Git.Types
import Git.Command
+import Git.FilePath
{- Streamers are passed a callback and should feed it lines in the form
- read by update-index, and generated by ls-tree. -}
@@ -37,13 +39,14 @@ stream_update_index repo as = do
hPutStr h s
hPutStr h "\0"
-{- Generates a line suitable to be fed into update-index, to add
- - a given file with a given sha. -}
-update_index_line :: Sha -> FilePath -> String
-update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
-
{- Gets the current tree for a ref. -}
ls_tree :: Ref -> Repo -> Streamer
ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
where
params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
+
+{- Generates a line suitable to be fed into update-index, to add
+ - a given file with a given sha. -}
+update_index_line :: Sha -> BlobType -> TopFilePath -> String
+update_index_line sha filetype file =
+ show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file