1db7d27a45
Make Utility.Process wrap the parts of System.Process that I use, and add debug logging to them. Also wrote some higher-level code that allows running an action with handles to a processes stdin or stdout (or both), and checking its exit status, all in a single function call. As a bonus, the debug logging now indicates whether the process is being run to read from it, feed it data, chat with it (writing and reading), or just call it for its side effect.
76 lines
2.2 KiB
Haskell
76 lines
2.2 KiB
Haskell
{- git-update-index library
|
|
-
|
|
- Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
|
|
module Git.UpdateIndex (
|
|
Streamer,
|
|
pureStreamer,
|
|
streamUpdateIndex,
|
|
lsTree,
|
|
updateIndexLine,
|
|
unstageFile,
|
|
stageSymlink
|
|
) where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Types
|
|
import Git.Command
|
|
import Git.FilePath
|
|
import Git.Sha
|
|
|
|
{- 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. -}
|
|
streamUpdateIndex :: Repo -> [Streamer] -> IO ()
|
|
streamUpdateIndex repo as =
|
|
withHandle StdinHandle createProcessSuccess (proc "git" ps) $ \h -> do
|
|
fileEncoding h
|
|
forM_ as (stream h)
|
|
hClose h
|
|
where
|
|
ps = toCommand $ gitCommandLine params repo
|
|
params = map Param ["update-index", "-z", "--index-info"]
|
|
stream h a = a (streamer h)
|
|
streamer h s = do
|
|
hPutStr h s
|
|
hPutStr h "\0"
|
|
|
|
{- 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. -}
|
|
updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
|
|
updateIndexLine sha filetype file =
|
|
show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath 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
|
|
|
|
{- A streamer that adds a symlink to the index. -}
|
|
stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
|
|
stageSymlink file sha repo = do
|
|
!line <- updateIndexLine
|
|
<$> pure sha
|
|
<*> pure SymlinkBlob
|
|
<*> toTopFilePath file repo
|
|
return $ pureStreamer line
|