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

slightly improve hairy types

Browse source
This commit is contained in:
Joey Hess 2024-08-14 16:04:18 -04:00
parent 3e6eb2a58d
commit 63a3cedc45
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 11 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

11
Annex/Branch.hs
View file

@ -38,6 +38,7 @@ module Annex.Branch (
withIndex,
precache,
UnmergedBranches(..),
FileContents,
overBranchFileContents,
overJournalFileContents,
combineStaleJournalWithBranch,
@ -990,6 +991,8 @@ data UnmergedBranches t
= UnmergedBranches t
| NoUnmergedBranches t
type FileContents t b = Maybe (t, RawFilePath, Maybe (L.ByteString, Maybe b))
{- Runs an action on the content of selected files from the branch.
- This is much faster than reading the content of each file in turn,
- because it lets git cat-file stream content without blocking.
@ -1012,7 +1015,7 @@ overBranchFileContents
-- and in this case it's also possible for the callback to be
-- passed some of the same file content repeatedly.
-> (RawFilePath -> Maybe v)
-> (Annex (Maybe (v, RawFilePath, Maybe (L.ByteString, Maybe Bool))) -> Annex a)
-> (Annex (FileContents v Bool) -> Annex a)
-> Annex (UnmergedBranches (a, Git.Sha))
overBranchFileContents ignorejournal select go = do
st <- update
@ -1026,7 +1029,7 @@ overBranchFileContents ignorejournal select go = do
overBranchFileContents'
:: (RawFilePath -> Maybe v)
-> (Annex (Maybe (v, RawFilePath, Maybe (L.ByteString, Maybe Bool))) -> Annex a)
-> (Annex (FileContents v Bool) -> Annex a)
-> BranchState
-> Annex (a, Git.Sha)
overBranchFileContents' select go st = do
@ -1080,7 +1083,7 @@ overJournalFileContents
-- content may be stale or lack information committed to the
-- git-annex branch.
-> (RawFilePath -> Maybe v)
-> (Annex (Maybe (v, RawFilePath, Maybe (L.ByteString, Maybe b))) -> Annex a)
-> (Annex (FileContents v b) -> Annex a)
-> Annex a
overJournalFileContents handlestale select go = do
buf <- liftIO newEmptyMVar
@ -1090,7 +1093,7 @@ overJournalFileContents'
:: MVar ([RawFilePath], [RawFilePath])
-> (RawFilePath -> L.ByteString -> Annex (L.ByteString, Maybe b))
-> (RawFilePath -> Maybe a)
-> Annex (Maybe (a, RawFilePath, (Maybe (L.ByteString, Maybe b))))
-> Annex (FileContents a b)
overJournalFileContents' buf handlestale select =
liftIO (tryTakeMVar buf) >>= \case
Nothing -> do

10
Logs/Location.hs
View file

@ -39,6 +39,7 @@ module Logs.Location (
import Annex.Common
import qualified Annex.Branch
import Annex.Branch (FileContents)
import Logs
import Logs.Presence
import Types.Cluster
@ -230,7 +231,7 @@ overLocationLogs ignorejournal v =
overLocationLogs'
:: Bool
-> v
-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe Bool))) -> Annex v -> Annex v)
-> (Annex (FileContents Key Bool) -> Annex v -> Annex v)
-> (Key -> [UUID] -> v -> Annex v)
-> Annex (Annex.Branch.UnmergedBranches (v, Sha))
overLocationLogs' ignorejournal =
@ -280,14 +281,11 @@ overLocationLogsJournal v branchsha keyaction =
changedlocs _ _ _ Nothing = pure (S.empty, S.empty)
overLocationLogsHelper
:: ( (RawFilePath -> Maybe Key)
-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe b))) -> Annex v)
-> Annex a
)
:: ((RawFilePath -> Maybe Key) -> (Annex (FileContents Key b) -> Annex v) -> Annex a)
-> ((Maybe L.ByteString -> [UUID]) -> Key -> RawFilePath -> Maybe (L.ByteString, Maybe b) -> Annex u)
-> Bool
-> v
-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe b))) -> Annex v -> Annex v)
-> (Annex (FileContents Key b) -> Annex v -> Annex v)
-> (Key -> u -> v -> Annex v)
-> Annex a
overLocationLogsHelper runner locparserrunner canprecache iv discarder keyaction = do