diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/FilePath.hs | 34 | ||||
| -rw-r--r-- | Git/Types.hs | 8 | ||||
| -rw-r--r-- | Git/UnionMerge.hs | 3 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 15 |
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 |