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

10
Logs/Location.hs
View file

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