diff options
Diffstat (limited to 'Git/UpdateIndex.hs')
| -rw-r--r-- | Git/UpdateIndex.hs | 37 |
1 files changed, 27 insertions, 10 deletions
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 8c003dd13..a32db8b9d 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -7,9 +7,11 @@ module Git.UpdateIndex ( Streamer, - stream_update_index, - ls_tree, - update_index_line, + pureStreamer, + streamUpdateIndex, + lsTree, + updateIndexLine, + stageSymlink ) where import System.Cmd.Utils @@ -19,14 +21,19 @@ import Git import Git.Types import Git.Command import Git.FilePath +import Git.HashObject {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} type Streamer = (String -> IO ()) -> IO () +{- A streamer with a precalculated value. -} +pureStreamer :: String -> Streamer +pureStreamer s = \streamer -> streamer s + {- Streams content into update-index from a list of Streamers. -} -stream_update_index :: Repo -> [Streamer] -> IO () -stream_update_index repo as = do +streamUpdateIndex :: Repo -> [Streamer] -> IO () +streamUpdateIndex repo as = do (p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo) fileEncoding h forM_ as (stream h) @@ -39,14 +46,24 @@ stream_update_index repo as = do hPutStr h s hPutStr h "\0" -{- Gets the current tree for a ref. -} -ls_tree :: Ref -> Repo -> Streamer -ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo +{- A streamer that adds the current tree for a ref. Useful for eg, copying + - and modifying branches. -} +lsTree :: Ref -> Repo -> Streamer +lsTree (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 = +updateIndexLine :: Sha -> BlobType -> TopFilePath -> String +updateIndexLine sha filetype file = show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file + +{- A streamer that adds a symlink to the index. -} +stageSymlink :: FilePath -> String -> Repo -> IO Streamer +stageSymlink file linktext repo = do + line <- updateIndexLine + <$> hashObject BlobObject linktext repo + <*> pure SymlinkBlob + <*> toTopFilePath file repo + return $ pureStreamer line |