49 lines
1.3 KiB
Haskell
49 lines
1.3 KiB
Haskell
{- git-update-index library
|
|
-
|
|
- Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.UpdateIndex (
|
|
Streamer,
|
|
stream_update_index,
|
|
update_index_line,
|
|
ls_tree
|
|
) where
|
|
|
|
import System.Cmd.Utils
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Command
|
|
|
|
{- 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 ()
|
|
|
|
{- Streams content into update-index from a list of Streamers. -}
|
|
stream_update_index :: Repo -> [Streamer] -> IO ()
|
|
stream_update_index repo as = do
|
|
(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
|
|
fileEncoding h
|
|
forM_ as (stream h)
|
|
hClose h
|
|
forceSuccess p
|
|
where
|
|
params = map Param ["update-index", "-z", "--index-info"]
|
|
stream h a = a (streamer h)
|
|
streamer h s = 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]
|