summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/View.hs2
-rw-r--r--Assistant/Threads/TransferScanner.hs2
-rw-r--r--Assistant/Threads/Watcher.hs2
-rw-r--r--Backend.hs24
-rw-r--r--Command.hs6
-rw-r--r--Command/Add.hs2
-rw-r--r--Command/AddUrl.hs4
-rw-r--r--Command/Copy.hs6
-rw-r--r--Command/Direct.hs2
-rw-r--r--Command/Drop.hs4
-rw-r--r--Command/Find.hs4
-rw-r--r--Command/Fix.hs4
-rw-r--r--Command/Fsck.hs16
-rw-r--r--Command/Get.hs4
-rw-r--r--Command/ImportFeed.hs2
-rw-r--r--Command/Indirect.hs2
-rw-r--r--Command/List.hs4
-rw-r--r--Command/Log.hs12
-rw-r--r--Command/MetaData.hs4
-rw-r--r--Command/Migrate.hs22
-rw-r--r--Command/Mirror.hs4
-rw-r--r--Command/Move.hs4
-rw-r--r--Command/ReKey.hs2
-rw-r--r--Command/Reinject.hs23
-rw-r--r--Command/RmUrl.hs2
-rw-r--r--Command/Sync.hs4
-rw-r--r--Command/Unannex.hs4
-rw-r--r--Command/Uninit.hs2
-rw-r--r--Command/Unlock.hs4
-rw-r--r--Command/Unused.hs4
-rw-r--r--Command/Whereis.hs4
-rw-r--r--Limit.hs9
-rw-r--r--Test.hs12
33 files changed, 112 insertions, 94 deletions
diff --git a/Annex/View.hs b/Annex/View.hs
index 7c187befd..5cf21cdfe 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -348,7 +348,7 @@ applyView' mkviewedfile getfilemetadata view = do
void clean
where
genviewedfiles = viewedFiles view mkviewedfile -- enables memoization
- go uh hasher f (Just (k, _)) = do
+ go uh hasher f (Just k) = do
metadata <- getCurrentMetaData k
let metadata' = getfilemetadata f `unionMetaData` metadata
forM_ (genviewedfiles f metadata') $ \fv -> do
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 6df9b1e18..daced8d21 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -151,7 +151,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
enqueue f (r, t) =
queueTransferWhenSmall "expensive scan found missing object"
(Just f) t r
- findtransfers f unwanted (key, _) = do
+ findtransfers f unwanted key = do
{- The syncable remotes may have changed since this
- scan began. -}
syncrs <- syncDataRemotes <$> getDaemonStatus
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 97ccf083e..0ed1bd22f 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -271,7 +271,7 @@ onAddSymlink :: Bool -> Handler
onAddSymlink isdirect file filestatus = unlessIgnored file $ do
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
kv <- liftAnnex (Backend.lookupFile file)
- onAddSymlink' linktarget (fmap fst kv) isdirect file filestatus
+ onAddSymlink' linktarget kv isdirect file filestatus
onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler
onAddSymlink' linktarget mk isdirect file filestatus = go mk
diff --git a/Backend.hs b/Backend.hs
index 38314687a..dded0d005 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,6 +1,6 @@
{- git-annex key/value backends
-
- - Copyright 2010,2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -10,6 +10,7 @@ module Backend (
orderedList,
genKey,
lookupFile,
+ getBackend,
isAnnexLink,
chooseBackend,
lookupBackendName,
@@ -74,7 +75,7 @@ genKey' (b:bs) source = do
| c == '\n' = '_'
| otherwise = c
-{- Looks up the key and backend corresponding to an annexed file,
+{- Looks up the key corresponding to an annexed file,
- by examining what the file links to.
-
- In direct mode, there is often no link on disk, in which case
@@ -82,7 +83,7 @@ genKey' (b:bs) source = do
- on disk still takes precedence over what was committed to git in direct
- mode.
-}
-lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
+lookupFile :: FilePath -> Annex (Maybe Key)
lookupFile file = do
mkey <- isAnnexLink file
case mkey of
@@ -92,14 +93,15 @@ lookupFile file = do
, return Nothing
)
where
- makeret k = let bname = keyBackendName k in
- case maybeLookupBackendName bname of
- Just backend -> return $ Just (k, backend)
- Nothing -> do
- warning $
- "skipping " ++ file ++
- " (unknown backend " ++ bname ++ ")"
- return Nothing
+ makeret k = return $ Just k
+
+getBackend :: FilePath -> Key -> Annex (Maybe Backend)
+getBackend file k = let bname = keyBackendName k in
+ case maybeLookupBackendName bname of
+ Just backend -> return $ Just backend
+ Nothing -> do
+ warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")"
+ return Nothing
{- Looks up the backend that should be used for a file.
- That can be configured on a per-file basis in the gitattributes file. -}
diff --git a/Command.hs b/Command.hs
index 3faa4053c..fc440f291 100644
--- a/Command.hs
+++ b/Command.hs
@@ -70,11 +70,11 @@ stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
stopUnless c a = ifM c ( a , stop )
{- Modifies an action to only act on files that are already annexed,
- - and passes the key and backend on to it. -}
-whenAnnexed :: (FilePath -> (Key, Backend) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
+ - and passes the key on to it. -}
+whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
-ifAnnexed :: FilePath -> ((Key, Backend) -> Annex a) -> Annex a -> Annex a
+ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
isBareRepo :: Annex Bool
diff --git a/Command/Add.hs b/Command/Add.hs
index f9e2b3342..46a873151 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -73,7 +73,7 @@ start file = ifAnnexed file addpresent add
| otherwise -> do
showStart "add" file
next $ perform file
- addpresent (key, _) = ifM isDirect
+ addpresent key = ifM isDirect
( ifM (goodContent key file) ( stop , add )
, fixup key
)
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index b108be507..7ffb86997 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -96,7 +96,7 @@ performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform
performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
where
quviurl = setDownloader pageurl QuviDownloader
- addurl (key, _backend) = next $ cleanup quviurl file key Nothing
+ addurl key = next $ cleanup quviurl file key Nothing
geturl = next $ addUrlFileQuvi relaxed quviurl videourl file
#endif
@@ -130,7 +130,7 @@ perform :: Bool -> URLString -> FilePath -> CommandPerform
perform relaxed url file = ifAnnexed file addurl geturl
where
geturl = next $ addUrlFile relaxed url file
- addurl (key, _backend)
+ addurl key
| relaxed = do
setUrlPresent key url
next $ return True
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 29606061d..ae254aae2 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -30,9 +30,9 @@ seek ps = do
{- A copy is just a move that does not delete the source file.
- However, --auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
-start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start to from file (key, backend) = stopUnless shouldCopy $
- Command.Move.start to from False file (key, backend)
+start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
+start to from file key = stopUnless shouldCopy $
+ Command.Move.start to from False file key
where
shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
check = case to of
diff --git a/Command/Direct.hs b/Command/Direct.hs
index 47f622a81..9727549b6 100644
--- a/Command/Direct.hs
+++ b/Command/Direct.hs
@@ -47,7 +47,7 @@ perform = do
void $ liftIO clean
next cleanup
where
- go = whenAnnexed $ \f (k, _) -> do
+ go = whenAnnexed $ \f k -> do
r <- toDirectGen k f
case r of
Nothing -> noop
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 71f19a828..4bac07a53 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -34,8 +34,8 @@ seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
withFilesInGit (whenAnnexed $ start from) ps
-start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = checkDropAuto from file key $ \numcopies ->
+start :: Maybe Remote -> FilePath -> Key -> CommandStart
+start from file key = checkDropAuto from file key $ \numcopies ->
stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $
case from of
Nothing -> startLocal (Just file) numcopies key Nothing
diff --git a/Command/Find.hs b/Command/Find.hs
index c6a32a944..bcf83729a 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -39,8 +39,8 @@ seek ps = do
format <- getFormat
withFilesInGit (whenAnnexed $ start format) ps
-start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
-start format file (key, _) = do
+start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart
+start format file key = do
-- only files inAnnex are shown, unless the user has requested
-- others via a limit
whenM (limited <||> inAnnex key) $
diff --git a/Command/Fix.hs b/Command/Fix.hs
index f730226e3..0c2bf5942 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -26,8 +26,8 @@ seek :: CommandSeek
seek = withFilesInGit $ whenAnnexed start
{- Fixes the symlink to an annexed file. -}
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = do
+start :: FilePath -> Key -> CommandStart
+start file key = do
link <- inRepo $ gitAnnexLink file key
stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
showStart "fix" file
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 88a9915c4..a17662d62 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -104,12 +104,16 @@ getIncremental = do
resetStartTime
return True
-start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart
-start from inc file (key, backend) = do
- numcopies <- getFileNumCopies file
- case from of
- Nothing -> go $ perform key file backend numcopies
- Just r -> go $ performRemote key file backend numcopies r
+start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
+start from inc file key = do
+ v <- Backend.getBackend file key
+ case v of
+ Nothing -> stop
+ Just backend -> do
+ numcopies <- getFileNumCopies file
+ case from of
+ Nothing -> go $ perform key file backend numcopies
+ Just r -> go $ performRemote key file backend numcopies r
where
go = runFsck inc file key
diff --git a/Command/Get.hs b/Command/Get.hs
index bef466724..d0be20018 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -31,8 +31,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start from)
ps
-start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = start' expensivecheck from key (Just file)
+start :: Maybe Remote -> FilePath -> Key -> CommandStart
+start from file key = start' expensivecheck from key (Just file)
where
expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file))
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index 3f629af6e..80e59b739 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -194,7 +194,7 @@ performDownload relaxed cache todownload = case location todownload of
in d </> show n ++ "_" ++ base
tryanother = makeunique url (n + 1) file
alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f)
- checksameurl (k, _) = ifM (elem url <$> getUrls k)
+ checksameurl k = ifM (elem url <$> getUrls k)
( return Nothing
, tryanother
)
diff --git a/Command/Indirect.hs b/Command/Indirect.hs
index c0dd57959..acf40c974 100644
--- a/Command/Indirect.hs
+++ b/Command/Indirect.hs
@@ -74,7 +74,7 @@ perform = do
case r of
Just s
| isSymbolicLink s -> void $ flip whenAnnexed f $
- \_ (k, _) -> do
+ \_ k -> do
removeInodeCache k
removeAssociatedFiles k
return Nothing
diff --git a/Command/List.hs b/Command/List.hs
index 1fa206405..d038d6deb 100644
--- a/Command/List.hs
+++ b/Command/List.hs
@@ -60,8 +60,8 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
-start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart
-start l file (key, _) = do
+start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
+start l file key = do
ls <- S.fromList <$> keyLocations key
liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
stop
diff --git a/Command/Log.hs b/Command/Log.hs
index 84583a93a..b0109f117 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -64,9 +64,15 @@ seek ps = do
Annex.getField (optionName o)
use o v = [Param ("--" ++ optionName o), Param v]
-start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool ->
- FilePath -> (Key, Backend) -> CommandStart
-start m zone os gource file (key, _) = do
+start
+ :: M.Map UUID String
+ -> TimeZone
+ -> [CommandParam]
+ -> Bool
+ -> FilePath
+ -> Key
+ -> CommandStart
+start m zone os gource file key = do
showLog output =<< readLog <$> getLog key os
-- getLog produces a zombie; reap it
liftIO reapZombies
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index d932315ab..38f9b8522 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -63,8 +63,8 @@ seek ps = do
(withFilesInGit (whenAnnexed $ start now getfield modmeta))
ps
-start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
-start now f ms file (k, _) = start' (Just file) now f ms k
+start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
+start now f ms file = start' (Just file) now f ms
startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
startKeys = start' Nothing
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index c14c07bdd..18e6e0748 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -25,15 +25,19 @@ def = [notDirect $
seek :: CommandSeek
seek = withFilesInGit $ whenAnnexed start
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, oldbackend) = do
- exists <- inAnnex key
- newbackend <- choosebackend =<< chooseBackend file
- if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
- then do
- showStart "migrate" file
- next $ perform file key oldbackend newbackend
- else stop
+start :: FilePath -> Key -> CommandStart
+start file key = do
+ v <- Backend.getBackend file key
+ case v of
+ Nothing -> stop
+ Just oldbackend -> do
+ exists <- inAnnex key
+ newbackend <- choosebackend =<< chooseBackend file
+ if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
+ then do
+ showStart "migrate" file
+ next $ perform file key oldbackend newbackend
+ else stop
where
choosebackend Nothing = Prelude.head <$> orderedList
choosebackend (Just backend) = return backend
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index 4a7a8dd99..4e9a85009 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -31,8 +31,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start to from)
ps
-start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start to from file (key, _backend) = startKey to from (Just file) key
+start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
+start to from file key = startKey to from (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
startKey to from afile key = do
diff --git a/Command/Move.hs b/Command/Move.hs
index 206a875b7..396ea4afc 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -33,8 +33,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start to from True)
ps
-start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
-start to from move file (key, _) = start' to from move (Just file) key
+start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
+start to from move file key = start' to from move (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startKey to from move = start' to from move Nothing
diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index 805300f9f..2919a09e9 100644
--- a/Command/ReKey.hs
+++ b/Command/ReKey.hs
@@ -29,7 +29,7 @@ start :: (FilePath, String) -> CommandStart
start (file, keyname) = ifAnnexed file go stop
where
newkey = fromMaybe (error "bad key") $ file2key keyname
- go (oldkey, _)
+ go oldkey
| oldkey == newkey = stop
| otherwise = do
showStart "rekey" file
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 1609c6097..a516fe93c 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -12,6 +12,7 @@ import Command
import Logs.Location
import Annex.Content
import qualified Command.Fsck
+import qualified Backend
def :: [Command]
def = [command "reinject" (paramPair "SRC" "DEST") seek
@@ -33,16 +34,20 @@ start (src:dest:[])
next $ whenAnnexed (perform src) dest
start _ = error "specify a src file and a dest file"
-perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
-perform src _dest (key, backend) =
+perform :: FilePath -> FilePath -> Key -> CommandPerform
+perform src dest key = do
{- Check the content before accepting it. -}
- ifM (Command.Fsck.checkKeySizeOr reject key src
- <&&> Command.Fsck.checkBackendOr reject backend key src)
- ( do
- unlessM move $ error "mv failed!"
- next $ cleanup key
- , error "not reinjecting"
- )
+ v <- Backend.getBackend dest key
+ case v of
+ Nothing -> stop
+ Just backend ->
+ ifM (Command.Fsck.checkKeySizeOr reject key src
+ <&&> Command.Fsck.checkBackendOr reject backend key src)
+ ( do
+ unlessM move $ error "mv failed!"
+ next $ cleanup key
+ , error "not reinjecting"
+ )
where
-- the file might be on a different filesystem,
-- so mv is used rather than simply calling
diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs
index 3f304b76e..e961575a3 100644
--- a/Command/RmUrl.hs
+++ b/Command/RmUrl.hs
@@ -20,7 +20,7 @@ seek :: CommandSeek
seek = withPairs start
start :: (FilePath, String) -> CommandStart
-start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do
+start (file, url) = flip whenAnnexed file $ \_ key -> do
showStart "rmurl" file
next $ next $ cleanup url key
diff --git a/Command/Sync.hs b/Command/Sync.hs
index dfcb0d22a..a5d6d46f1 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -338,8 +338,8 @@ seekSyncContent rs = do
(\v -> void (liftIO (tryPutMVar mvar ())) >> syncFile rs f v)
noop
-syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex ()
-syncFile rs f (k, _) = do
+syncFile :: [Remote] -> FilePath -> Key -> Annex ()
+syncFile rs f k = do
locs <- loggedLocations k
let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index ca9788ddb..daa14ce85 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -58,8 +58,8 @@ wrapUnannex a = ifM isDirect
then void (liftIO cleanup) >> return True
else void (liftIO cleanup) >> return False
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = stopUnless (inAnnex key) $ do
+start :: FilePath -> Key -> CommandStart
+start file key = stopUnless (inAnnex key) $ do
showStart "unannex" file
next $ ifM isDirect
( performDirect file key
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index dccf4a614..0f0628156 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -44,7 +44,7 @@ seek ps = do
{- git annex symlinks that are not checked into git could be left by an
- interrupted add. -}
-startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart
+startCheckIncomplete :: FilePath -> Key -> CommandStart
startCheckIncomplete file _ = error $ unlines
[ file ++ " points to annexed content, but is not checked into git."
, "Perhaps this was left behind by an interrupted git annex add?"
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 4cfe39307..0070410a6 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -25,8 +25,8 @@ seek = withFilesInGit $ whenAnnexed start
{- The unlock subcommand replaces the symlink with a copy of the file's
- content. -}
-start :: FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = do
+start :: FilePath -> Key -> CommandStart
+start file key = do
showStart "unlock" file
next $ perform file key
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 3e844e5a8..5815bbf29 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -250,7 +250,7 @@ withKeysReferenced' mdir initial a = do
x <- Backend.lookupFile f
case x of
Nothing -> go v fs
- Just (k, _) -> do
+ Just k -> do
!v' <- a k f v
go v' fs
@@ -294,7 +294,7 @@ withKeysReferencedInGitRef a ref = do
forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
liftIO $ void clean
where
- tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file
+ tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file
tKey False = fileKey . takeFileName . decodeBS <$$>
catFile ref . getTopFilePath . DiffTree.file
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 387ffebc9..d2c27eb9b 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -27,8 +27,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start m)
ps
-start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart
-start remotemap file (key, _) = start' remotemap key (Just file)
+start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
+start remotemap file key = start' remotemap key (Just file)
startKeys :: M.Map UUID Remote -> Key -> CommandStart
startKeys remotemap key = start' remotemap key Nothing
diff --git a/Limit.hs b/Limit.hs
index b46ff1a06..9ac849bce 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -234,10 +234,10 @@ limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ go sz
where
- go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz
+ go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz
go sz _ (MatchingKey key) = checkkey sz key
checkkey sz key = return $ keySize key `vs` Just sz
- check _ sz (Just (key, _)) = checkkey sz key
+ check _ sz (Just key) = checkkey sz key
check fi sz Nothing = do
filesize <- liftIO $ catchMaybeIO $
fromIntegral . fileSize
@@ -272,11 +272,8 @@ addTimeLimit s = do
liftIO $ exitWith $ ExitFailure 101
else return True
-lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
-lookupFile = Backend.lookupFile . relFile
-
lookupFileKey :: FileInfo -> Annex (Maybe Key)
-lookupFileKey = (fst <$>) <$$> Backend.lookupFile . relFile
+lookupFileKey = Backend.lookupFile . relFile
checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
diff --git a/Test.hs b/Test.hs
index afcd5790e..55546d08b 100644
--- a/Test.hs
+++ b/Test.hs
@@ -712,7 +712,7 @@ test_unused env = intmpclonerepoInDirect env $ do
(sort expectedkeys) (sort unusedkeys)
findkey f = do
r <- Backend.lookupFile f
- return $ fst $ fromJust r
+ return $ fromJust r
test_describe :: TestEnv -> Assertion
test_describe env = intmpclonerepo env $ do
@@ -1233,7 +1233,7 @@ test_crypto env = do
(c,k) <- annexeval $ do
uuid <- Remote.nameToUUID "foo"
rs <- Logs.Remote.readRemoteLog
- Just (k,_) <- Backend.lookupFile annexedfile
+ Just k <- Backend.lookupFile annexedfile
return (fromJust $ M.lookup uuid rs, k)
let key = if scheme `elem` ["hybrid","pubkey"]
then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
@@ -1500,7 +1500,7 @@ checklocationlog f expected = do
thisuuid <- annexeval Annex.UUID.getUUID
r <- annexeval $ Backend.lookupFile f
case r of
- Just (k, _) -> do
+ Just k -> do
uuids <- annexeval $ Remote.keyLocations k
assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid)
expected (thisuuid `elem` uuids)
@@ -1508,9 +1508,9 @@ checklocationlog f expected = do
checkbackend :: FilePath -> Types.Backend -> Assertion
checkbackend file expected = do
- r <- annexeval $ Backend.lookupFile file
- let b = snd $ fromJust r
- assertEqual ("backend for " ++ file) expected b
+ b <- annexeval $ maybe (return Nothing) (Backend.getBackend file)
+ =<< Backend.lookupFile file
+ assertEqual ("backend for " ++ file) (Just expected) b
inlocationlog :: FilePath -> Assertion
inlocationlog f = checklocationlog f True
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 06:18:19 +0000