slightly improve hairy types
authorJoey Hess <joeyh@joeyh.name>
Wed, 14 Aug 2024 20:04:18 +0000 (16:04 -0400)
committerJoey Hess <joeyh@joeyh.name>
Wed, 14 Aug 2024 20:04:18 +0000 (16:04 -0400)
Annex/Branch.hs
Logs/Location.hs

index 41d8f5354ba2433eb18d845f2c62ce50cae5af53..d75b8f249bb5ad98d8777ca84bb60b24c80ffd5f 100644 (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
index 73842ddd977d37acc9ac15a1367b7f4dd50982a3..73c1c5fe481e52ad55d29ece2a5243a6715e7b73 100644 (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