diff options
| author | Joey Hess <joeyh@joeyh.name> | 2023-08-14 12:06:32 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2023-08-14 12:12:52 -0400 |
| commit | edf83982be214f3c839fab9b659f645de53a9100 (patch) | |
| tree | bef06cb750379c6d7942fc13b13fcb328201354c /Git/UpdateIndex.hs | |
| parent | f0cd3a2a3758ddcd2f0900c16bdc1fb80bbd6e92 (diff) | |
| download | git-repair-edf83982be214f3c839fab9b659f645de53a9100.tar.gz | |
merge from git-annex
Support building with unix-compat 0.7
Diffstat (limited to 'Git/UpdateIndex.hs')
| -rw-r--r-- | Git/UpdateIndex.hs | 40 |
1 files changed, 25 insertions, 15 deletions
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 74816a6..f56bc86 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -1,6 +1,6 @@ {- git-update-index library - - - Copyright 2011-2020 Joey Hess <id@joeyh.name> + - Copyright 2011-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} @@ -99,15 +99,15 @@ updateIndexLine sha treeitemtype file = L.fromStrict $ <> "\t" <> indexPath file -stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer +stageFile :: Sha -> TreeItemType -> RawFilePath -> Repo -> IO Streamer stageFile sha treeitemtype file repo = do - p <- toTopFilePath (toRawFilePath file) repo + p <- toTopFilePath file repo return $ pureStreamer $ updateIndexLine sha treeitemtype p {- A streamer that removes a file from the index. -} -unstageFile :: FilePath -> Repo -> IO Streamer +unstageFile :: RawFilePath -> Repo -> IO Streamer unstageFile file repo = do - p <- toTopFilePath (toRawFilePath file) repo + p <- toTopFilePath file repo return $ unstageFile' p unstageFile' :: TopFilePath -> Streamer @@ -135,9 +135,17 @@ stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of indexPath :: TopFilePath -> InternalGitPath indexPath = toInternalGitPath . getTopFilePath -{- Refreshes the index, by checking file stat information. -} -refreshIndex :: Repo -> ((RawFilePath -> IO ()) -> IO ()) -> IO Bool -refreshIndex repo feeder = withCreateProcess p go +{- Refreshes the index, by checking file stat information. + - + - The action is passed a callback that it can use to send filenames to + - update-index. Sending Nothing will wait for update-index to finish + - updating the index. + -} +refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe RawFilePath -> IO ()) -> m ()) -> m () +refreshIndex repo feeder = bracket + (liftIO $ createProcess p) + (liftIO . cleanupProcess) + go where params = [ Param "update-index" @@ -150,10 +158,12 @@ refreshIndex repo feeder = withCreateProcess p go p = (gitCreateProcess params repo) { std_in = CreatePipe } - go (Just h) _ _ pid = do - feeder $ \f -> - S.hPut h (S.snoc f 0) - hFlush h - hClose h - checkSuccessProcess pid - go _ _ _ _ = error "internal" + go (Just h, _, _, pid) = do + let closer = do + hClose h + forceSuccessProcess p pid + feeder $ \case + Just f -> S.hPut h (S.snoc f 0) + Nothing -> closer + liftIO $ closer + go _ = error "internal" |