mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

generalize refreshIndex to MonadIO

Browse source 
Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
Joey Hess 2022-09-23 14:28:52 -04:00
parent b17e328175
commit 9c76e503cf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 11 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
Git/UpdateIndex.hs
View file

@ -1,6 +1,6 @@
{- git-update-index library {- 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. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -136,8 +136,11 @@ indexPath :: TopFilePath -> InternalGitPath
indexPath = toInternalGitPath . getTopFilePath indexPath = toInternalGitPath . getTopFilePath
{- Refreshes the index, by checking file stat information. -} {- Refreshes the index, by checking file stat information. -}
refreshIndex :: Repo -> ((RawFilePath -> IO ()) -> IO ()) -> IO Bool refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((RawFilePath -> IO ()) -> m ()) -> m Bool
refreshIndex repo feeder = withCreateProcess p go refreshIndex repo feeder = bracket
(liftIO $ createProcess p)
(liftIO . cleanupProcess)
go
where where
params = params =
[ Param "update-index" [ Param "update-index"
@ -150,10 +153,10 @@ refreshIndex repo feeder = withCreateProcess p go
p = (gitCreateProcess params repo) p = (gitCreateProcess params repo)
{ std_in = CreatePipe } { std_in = CreatePipe }
go (Just h) _ _ pid = do go (Just h, _, _, pid) = do
feeder $ \f -> feeder $ \f ->
S.hPut h (S.snoc f 0) S.hPut h (S.snoc f 0)
hFlush h liftIO $ hFlush h
hClose h liftIO $ hClose h
checkSuccessProcess pid liftIO $ checkSuccessProcess pid
go _ _ _ _ = error "internal" go _ = error "internal"