diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index bcde9ba4a8..77c0f3f72f 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -89,7 +89,7 @@ fileMatchInfo file mkey = do matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) return $ MatchingFile FileInfo { matchFile = matchfile - , contentFile = Just file + , contentFile = file , matchKey = mkey } diff --git a/Annex/Import.hs b/Annex/Import.hs index 115f9a1ec5..b82f8fa97b 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -568,7 +568,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec mkkey tmpfile = do let mi = MatchingFile FileInfo { matchFile = f - , contentFile = Just tmpfile + , contentFile = tmpfile , matchKey = Nothing } islargefile <- checkMatcher' matcher mi mempty diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 66e1d71c69..489f68c295 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -383,7 +383,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mt af = AssociatedFile (Just file) mi = case mtmp of Just tmp -> MatchingFile $ FileInfo - { contentFile = Just tmp + { contentFile = tmp , matchFile = file , matchKey = Just key } diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index d2667a819c..799f586e84 100644 --- a/CmdLine/Batch.hs +++ b/CmdLine/Batch.hs @@ -131,7 +131,7 @@ batchFilesMatching fmt a = do matcher <- getMatcher go $ \si f -> let f' = toRawFilePath f - in ifM (matcher $ MatchingFile $ FileInfo (Just f') f' Nothing) + in ifM (matcher $ MatchingFile $ FileInfo f' f' Nothing) ( a (si, f') , return Nothing ) diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index f6e9dee556..9377185cc6 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -121,7 +121,7 @@ withPathContents a params = do p' = toRawFilePath p checkmatch matcher (f, relf) = matcher $ MatchingFile $ FileInfo - { contentFile = Just f + { contentFile = f , matchFile = relf , matchKey = Nothing } @@ -311,7 +311,7 @@ seekFiltered prefilter a listfs = do go _ _ [] = return () go matcher checktimelimit (v@(_si, f):rest) = checktimelimit noop $ do whenM (prefilter v) $ - whenM (matcher $ MatchingFile $ FileInfo (Just f) f Nothing) $ + whenM (matcher $ MatchingFile $ FileInfo f f Nothing) $ a v go matcher checktimelimit rest @@ -375,7 +375,7 @@ seekFilteredKeys seeker listfs = do maybe noop (Annex.BranchState.setCache logf) logcontent checkMatcherWhen mi (matcherNeedsLocationLog mi && not (matcherNeedsFileName mi)) - (MatchingFile $ FileInfo (Just f) f (Just k)) + (MatchingFile $ FileInfo f f (Just k)) (commandAction $ startAction seeker si f k) precachefinisher mi lreader checktimelimit Nothing -> return () @@ -399,14 +399,14 @@ seekFilteredKeys seeker listfs = do -- checked later, to avoid a slow lookup here. (not ((matcherNeedsKey mi || matcherNeedsLocationLog mi) && not (matcherNeedsFileName mi))) - (MatchingFile $ FileInfo (Just f) f Nothing) + (MatchingFile $ FileInfo f f Nothing) (liftIO $ ofeeder ((si, f), sha)) keyaction f mi content a = case parseLinkTargetOrPointerLazy =<< content of Just k -> checkMatcherWhen mi (matcherNeedsKey mi && not (matcherNeedsFileName mi || matcherNeedsLocationLog mi)) - (MatchingFile $ FileInfo (Just f) f (Just k)) + (MatchingFile $ FileInfo f f (Just k)) (checkpresence k (a k)) Nothing -> noop diff --git a/Command/Add.hs b/Command/Add.hs index 73e355b421..7ded87490c 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -171,7 +171,7 @@ start o si file addunlockedmatcher = do perform :: AddOptions -> RawFilePath -> AddUnlockedMatcher -> CommandPerform perform o file addunlockedmatcher = withOtherTmp $ \tmpdir -> do lockingfile <- not <$> addUnlocked addunlockedmatcher - (MatchingFile (FileInfo (Just file) file Nothing)) + (MatchingFile (FileInfo file file Nothing)) True let cfg = LockDownConfig { lockingFile = lockingfile diff --git a/Command/Import.hs b/Command/Import.hs index d1957e0582..d10310a9bf 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -239,7 +239,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) = stop lockdown a = do let mi = MatchingFile $ FileInfo - { contentFile = Just srcfile + { contentFile = srcfile , matchFile = destfile , matchKey = Nothing } diff --git a/Command/Info.hs b/Command/Info.hs index 34801d19c8..f90230cac0 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -569,7 +569,7 @@ getDirStatInfo o dir = do where initial = (emptyKeyInfo, emptyKeyInfo, emptyNumCopiesStats, M.empty) update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) = - ifM (matcher $ MatchingFile $ FileInfo (Just file) file (Just key)) + ifM (matcher $ MatchingFile $ FileInfo file file (Just key)) ( do !presentdata' <- ifM (inAnnex key) ( return $ addKey key presentdata diff --git a/Command/Multicast.hs b/Command/Multicast.hs index b2c6093d4f..8133e1e726 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -135,7 +135,7 @@ send ups fs = do (fs', cleanup) <- seekHelper id ww LsFiles.inRepo =<< workTreeItems ww fs matcher <- Limit.getMatcher - let addlist f o = whenM (matcher $ MatchingFile $ FileInfo (Just f) f Nothing) $ + let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f Nothing) $ liftIO $ hPutStrLn h o forM_ fs' $ \(_, f) -> do mk <- lookupKey f diff --git a/Limit.hs b/Limit.hs index 145b57291e..e68c47fb33 100644 --- a/Limit.hs +++ b/Limit.hs @@ -166,14 +166,12 @@ matchMagic _limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just } where cglob = compileGlob glob CaseSensative (GlobFilePath False) -- memoized - go (MatchingKey k _) = withObjectLoc k $ \obj -> + go (MatchingKey k _) = withObjectLoc k $ \obj -> catchBoolIO $ maybe False (matchGlob cglob) <$> querymagic magic (fromRawFilePath obj) - go (MatchingFile fi) = case contentFile fi of - Just f -> catchBoolIO $ - maybe False (matchGlob cglob) - <$> querymagic magic (fromRawFilePath f) - Nothing -> return False + go (MatchingFile fi) = catchBoolIO $ + maybe False (matchGlob cglob) + <$> querymagic magic (fromRawFilePath (contentFile fi)) go (MatchingInfo p) = pure $ maybe False (matchGlob cglob) (selectprovidedinfo p) go (MatchingUserInfo p) = @@ -203,14 +201,13 @@ matchLockStatus :: Bool -> MatchInfo -> Annex Bool matchLockStatus _ (MatchingKey _ _) = pure False matchLockStatus _ (MatchingInfo _) = pure False matchLockStatus _ (MatchingUserInfo _) = pure False -matchLockStatus wantlocked (MatchingFile fi) = case contentFile fi of - Just f -> liftIO $ do - islocked <- isPointerFile f >>= \case - Just _key -> return False - Nothing -> isSymbolicLink - <$> getSymbolicLinkStatus (fromRawFilePath f) - return (islocked == wantlocked) - Nothing -> return False +matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do + let f = contentFile fi + islocked <- isPointerFile f >>= \case + Just _key -> return False + Nothing -> isSymbolicLink + <$> getSymbolicLinkStatus (fromRawFilePath f) + return (islocked == wantlocked) {- Adds a limit to skip files not believed to be present - in a specfied repository. Optionally on a prior date. -} @@ -462,21 +459,18 @@ limitSize lb vs s = case readSize dataUnits s of } where go sz _ (MatchingFile fi) = case lb of - LimitAnnexFiles -> goannexed sz fi - LimitDiskFiles -> case contentFile fi of - Just f -> do - filesize <- liftIO $ catchMaybeIO $ getFileSize f - return $ filesize `vs` Just sz - Nothing -> goannexed sz fi + LimitAnnexFiles -> lookupFileKey fi >>= \case + Just key -> checkkey sz key + Nothing -> return False + LimitDiskFiles -> do + filesize <- liftIO $ catchMaybeIO $ getFileSize (contentFile fi) + return $ filesize `vs` Just sz go sz _ (MatchingKey key _) = checkkey sz key go sz _ (MatchingInfo p) = return $ Just (providedFileSize p) `vs` Just sz go sz _ (MatchingUserInfo p) = getUserInfo (userProvidedFileSize p) >>= \sz' -> return (Just sz' `vs` Just sz) - goannexed sz fi = lookupFileKey fi >>= \case - Just key -> checkkey sz key - Nothing -> return False checkkey sz key = return $ fromKey keySize key `vs` Just sz addMetaData :: String -> Annex () @@ -519,9 +513,7 @@ addAccessedWithin duration = do lookupFileKey :: FileInfo -> Annex (Maybe Key) lookupFileKey fi = case matchKey fi of Just k -> return (Just k) - Nothing -> case contentFile fi of - Just f -> lookupKey f - Nothing -> return Nothing + Nothing -> lookupKey (contentFile fi) checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs index 2b8811d743..8ac1274d1d 100644 --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -29,7 +29,7 @@ data MatchInfo | MatchingUserInfo UserProvidedInfo data FileInfo = FileInfo - { contentFile :: Maybe RawFilePath + { contentFile :: RawFilePath -- ^ path to a file containing the content, for operations -- that examine it , matchFile :: RawFilePath