diff options
Diffstat (limited to 'Git/UpdateIndex.hs')
| -rw-r--r-- | Git/UpdateIndex.hs | 72 |
1 files changed, 51 insertions, 21 deletions
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 55c5b3b..9f07cf5 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -1,11 +1,11 @@ {- git-update-index library - - - Copyright 2011-2013 Joey Hess <id@joeyh.name> + - Copyright 2011-2019 Joey Hess <id@joeyh.name> - - - Licensed under the GNU GPL version 3 or higher. + - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns, OverloadedStrings, CPP #-} module Git.UpdateIndex ( Streamer, @@ -21,6 +21,7 @@ module Git.UpdateIndex ( unstageFile, stageSymlink, stageDiffTreeItem, + refreshIndex, ) where import Common @@ -31,12 +32,14 @@ import Git.FilePath import Git.Sha import qualified Git.DiffTreeItem as Diff +import qualified Data.ByteString.Lazy as L + {- 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 () +type Streamer = (L.ByteString -> IO ()) -> IO () {- A streamer with a precalculated value. -} -pureStreamer :: String -> Streamer +pureStreamer :: L.ByteString -> Streamer pureStreamer !s = \streamer -> streamer s {- Streams content into update-index from a list of Streamers. -} @@ -48,14 +51,13 @@ data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO () streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do - hPutStr h s - hPutStr h "\0" + L.hPutStr h s + L.hPutStr h "\0" startUpdateIndex :: Repo -> IO UpdateIndexHandle startUpdateIndex repo = do (Just h, _, _, p) <- createProcess (gitCreateProcess params repo) { std_in = CreatePipe } - fileEncoding h return $ UpdateIndexHandle p h where params = map Param ["update-index", "-z", "--index-info"] @@ -84,38 +86,66 @@ lsSubTree (Ref x) p repo streamer = do {- 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 " ++ fromRef sha ++ "\t" ++ indexPath file - -stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer -stageFile sha filetype file repo = do - p <- toTopFilePath file repo - return $ pureStreamer $ updateIndexLine sha filetype p +updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> L.ByteString +updateIndexLine sha treeitemtype file = L.fromStrict $ + fmtTreeItemType treeitemtype + <> " blob " + <> encodeBS (fromRef sha) + <> "\t" + <> indexPath file + +stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer +stageFile sha treeitemtype file repo = do + p <- toTopFilePath (toRawFilePath file) repo + return $ pureStreamer $ updateIndexLine sha treeitemtype p {- A streamer that removes a file from the index. -} unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do - p <- toTopFilePath file repo + p <- toTopFilePath (toRawFilePath file) repo return $ unstageFile' p unstageFile' :: TopFilePath -> Streamer -unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p +unstageFile' p = pureStreamer $ L.fromStrict $ + "0 " + <> encodeBS' (fromRef nullSha) + <> "\t" + <> indexPath 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 + <*> pure TreeSymlink + <*> toTopFilePath (toRawFilePath file) repo return $ pureStreamer line {- A streamer that applies a DiffTreeItem to the index. -} stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer -stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of +stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of Nothing -> unstageFile' (Diff.file d) Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d) indexPath :: TopFilePath -> InternalGitPath indexPath = toInternalGitPath . getTopFilePath + +{- Refreshes the index, by checking file stat information. -} +refreshIndex :: Repo -> ((FilePath -> IO ()) -> IO ()) -> IO Bool +refreshIndex repo feeder = do + (Just h, _, _, p) <- createProcess (gitCreateProcess params repo) + { std_in = CreatePipe } + feeder $ \f -> do + hPutStr h f + hPutStr h "\0" + hFlush h + hClose h + checkSuccessProcess p + where + params = + [ Param "update-index" + , Param "-q" + , Param "--refresh" + , Param "-z" + , Param "--stdin" + ] |