remove whenAnnexed and ifAnnexed
In preparation for adding a new variation on lookupKey. Sponsored-by: Max Thoursie on Patreon
This commit is contained in:
parent
1944549a38
commit
b2ee2496ee
12 changed files with 56 additions and 36 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git-annex worktree files
|
||||
-
|
||||
- Copyright 2013-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2022 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -45,14 +45,6 @@ lookupKey' catkeyfile file = isAnnexLink file >>= \case
|
|||
Just key -> return (Just key)
|
||||
Nothing -> catkeyfile file
|
||||
|
||||
{- Modifies an action to only act on files that are already annexed,
|
||||
- and passes the key on to it. -}
|
||||
whenAnnexed :: (RawFilePath -> Key -> Annex (Maybe a)) -> RawFilePath -> Annex (Maybe a)
|
||||
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
|
||||
|
||||
ifAnnexed :: RawFilePath -> (Key -> Annex a) -> Annex a -> Annex a
|
||||
ifAnnexed file yes no = maybe no yes =<< lookupKey file
|
||||
|
||||
{- Find all annexed files and update the keys database for them. -}
|
||||
scanAnnexedFiles :: Annex ()
|
||||
scanAnnexedFiles = Database.Keys.updateDatabase
|
||||
|
|
|
@ -186,8 +186,9 @@ batchAnnexed fmt seeker keyaction = do
|
|||
matcher <- getMatcher
|
||||
batchFilesKeys fmt $ \(si, v) ->
|
||||
case v of
|
||||
Right bf -> flip whenAnnexed bf $ \f k ->
|
||||
checkpresent k $
|
||||
Right f -> lookupKey f >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just k -> checkpresent k $
|
||||
startAction seeker si f k
|
||||
Left k -> ifM (matcher (MatchingInfo (mkinfo k)))
|
||||
( checkpresent k $
|
||||
|
|
|
@ -11,7 +11,6 @@ module Command (
|
|||
) where
|
||||
|
||||
import Annex.Common as ReExported
|
||||
import Annex.WorkTree as ReExported (whenAnnexed, ifAnnexed)
|
||||
import Types.Command as ReExported
|
||||
import Types.DeferredParse as ReExported
|
||||
import CmdLine.Seek as ReExported
|
||||
|
|
|
@ -18,6 +18,7 @@ import Annex.FileMatcher
|
|||
import Annex.Link
|
||||
import Annex.Tmp
|
||||
import Annex.HashObject
|
||||
import Annex.WorkTree
|
||||
import Messages.Progress
|
||||
import Git.FilePath
|
||||
import Git.Types
|
||||
|
@ -202,7 +203,9 @@ start dr si file addunlockedmatcher =
|
|||
mk <- liftIO $ isPointerFile file
|
||||
maybe (go s) (fixuppointer s) mk
|
||||
where
|
||||
go s = ifAnnexed file (addpresent s) (add s)
|
||||
go s = lookupKey file >>= \case
|
||||
Just k -> addpresent s k
|
||||
Nothing -> add s
|
||||
add s = starting "add" (ActionItemTreeFile file) si $
|
||||
skipWhenDryRun dr $
|
||||
if isSymbolicLink s
|
||||
|
|
|
@ -20,6 +20,7 @@ import Annex.Ingest
|
|||
import Annex.CheckIgnore
|
||||
import Annex.Perms
|
||||
import Annex.UUID
|
||||
import Annex.WorkTree
|
||||
import Annex.YoutubeDl
|
||||
import Annex.UntrustedFilePath
|
||||
import Logs.Web
|
||||
|
@ -183,7 +184,9 @@ startRemote addunlockedmatcher r o si file uri sz = do
|
|||
performRemote addunlockedmatcher r o uri (toRawFilePath file') sz
|
||||
|
||||
performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform
|
||||
performRemote addunlockedmatcher r o uri file sz = ifAnnexed file adduri geturi
|
||||
performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case
|
||||
Just k -> adduri k
|
||||
Nothing -> geturi
|
||||
where
|
||||
loguri = setDownloader uri OtherDownloader
|
||||
adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
|
||||
|
@ -270,7 +273,9 @@ checkPreserveFileNameSecurity f = do
|
|||
]
|
||||
|
||||
performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform
|
||||
performWeb addunlockedmatcher o url file urlinfo = ifAnnexed file addurl geturl
|
||||
performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case
|
||||
Just k -> addurl k
|
||||
Nothing -> geturl
|
||||
where
|
||||
geturl = next $ isJust <$> addUrlFile addunlockedmatcher (downloadOptions o) url urlinfo file
|
||||
addurl = addUrlChecked o url file webUUID $ \k ->
|
||||
|
@ -335,9 +340,9 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case
|
||||
Right mediafile ->
|
||||
let f = youtubeDlDestFile o file (toRawFilePath mediafile)
|
||||
in ifAnnexed f
|
||||
(alreadyannexed (fromRawFilePath f))
|
||||
(dl f)
|
||||
in lookupKey f >>= \case
|
||||
Just k -> alreadyannexed (fromRawFilePath f) k
|
||||
Nothing -> dl f
|
||||
Left err -> checkRaw (Just err) o Nothing (normalfinish tmp)
|
||||
where
|
||||
dl dest = withTmpWorkDir mediakey $ \workdir -> do
|
||||
|
|
|
@ -40,6 +40,7 @@ import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, Dow
|
|||
import Annex.UUID
|
||||
import Backend.URL (fromUrl)
|
||||
import Annex.Content
|
||||
import Annex.WorkTree
|
||||
import Annex.YoutubeDl
|
||||
import Types.MetaData
|
||||
import Logs.MetaData
|
||||
|
@ -297,7 +298,9 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
|
|||
- to be re-downloaded. -}
|
||||
makeunique url n file = ifM alreadyexists
|
||||
( ifM forced
|
||||
( ifAnnexed (toRawFilePath f) checksameurl tryanother
|
||||
( lookupKey (toRawFilePath f) >>= \case
|
||||
Just k -> checksameurl k
|
||||
Nothing -> tryanother
|
||||
, tryanother
|
||||
)
|
||||
, return $ Just f
|
||||
|
|
|
@ -28,6 +28,7 @@ import Utility.DiskFree
|
|||
import Annex.Content
|
||||
import Annex.UUID
|
||||
import Annex.CatFile
|
||||
import Annex.WorkTree
|
||||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
import Logs.Location
|
||||
|
@ -174,9 +175,9 @@ itemInfo o (si, p) = ifM (isdir p)
|
|||
Right u -> uuidInfo o u si
|
||||
Left _ -> do
|
||||
relp <- liftIO $ relPathCwdToFile (toRawFilePath p)
|
||||
ifAnnexed relp
|
||||
(fileInfo o (fromRawFilePath relp) si)
|
||||
(treeishInfo o p si)
|
||||
lookupKey relp >>= \case
|
||||
Just k -> fileInfo o (fromRawFilePath relp) si k
|
||||
Nothing -> treeishInfo o p si
|
||||
)
|
||||
where
|
||||
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
|
||||
|
|
|
@ -16,6 +16,7 @@ import Annex.Perms
|
|||
import Annex.ReplaceFile
|
||||
import Logs.Location
|
||||
import Annex.InodeSentinal
|
||||
import Annex.WorkTree
|
||||
import Utility.InodeCache
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
|
@ -61,7 +62,9 @@ seek o = case batchOption o of
|
|||
(toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
|
||||
|
||||
start :: SeekInput -> (RawFilePath, Key) -> CommandStart
|
||||
start si (file, newkey) = ifAnnexed file go stop
|
||||
start si (file, newkey) = lookupKey file >>= \case
|
||||
Just k -> go k
|
||||
Nothing -> stop
|
||||
where
|
||||
go oldkey
|
||||
| oldkey == newkey = stop
|
||||
|
|
|
@ -13,6 +13,7 @@ import Annex.Content
|
|||
import Backend
|
||||
import Types.KeySource
|
||||
import Utility.Metered
|
||||
import Annex.WorkTree
|
||||
import qualified Git
|
||||
|
||||
cmd :: Command
|
||||
|
@ -45,9 +46,9 @@ startSrcDest :: [FilePath] -> CommandStart
|
|||
startSrcDest ps@(src:dest:[])
|
||||
| src == dest = stop
|
||||
| otherwise = notAnnexed src' $
|
||||
ifAnnexed (toRawFilePath dest)
|
||||
go
|
||||
(giveup $ src ++ " is not an annexed file")
|
||||
lookupKey (toRawFilePath dest) >>= \case
|
||||
Just k -> go k
|
||||
Nothing -> giveup $ src ++ " is not an annexed file"
|
||||
where
|
||||
src' = toRawFilePath src
|
||||
go key = starting "reinject" ai si $
|
||||
|
@ -79,9 +80,9 @@ notAnnexed :: RawFilePath -> CommandStart -> CommandStart
|
|||
notAnnexed src a =
|
||||
ifM (fromRepo Git.repoIsLocalBare)
|
||||
( a
|
||||
, ifAnnexed src
|
||||
(giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src)
|
||||
a
|
||||
, lookupKey src >>= \case
|
||||
Just _ -> giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src
|
||||
Nothing -> a
|
||||
)
|
||||
|
||||
perform :: RawFilePath -> Key -> CommandPerform
|
||||
|
|
|
@ -9,6 +9,7 @@ module Command.RmUrl where
|
|||
|
||||
import Command
|
||||
import Logs.Web
|
||||
import Annex.WorkTree
|
||||
|
||||
cmd :: Command
|
||||
cmd = notBareRepo $
|
||||
|
@ -46,10 +47,12 @@ batchParser s = case separate (== ' ') (reverse s) of
|
|||
return $ Right (f', reverse ru)
|
||||
|
||||
start :: (SeekInput, (FilePath, URLString)) -> CommandStart
|
||||
start (si, (file, url)) = flip whenAnnexed file' $ \_ key -> do
|
||||
let ai = mkActionItem (key, AssociatedFile (Just file'))
|
||||
starting "rmurl" ai si $
|
||||
next $ cleanup url key
|
||||
start (si, (file, url)) = lookupKey file' >>= \case
|
||||
Nothing -> stop
|
||||
Just key -> do
|
||||
let ai = mkActionItem (key, AssociatedFile (Just file'))
|
||||
starting "rmurl" ai si $
|
||||
next $ cleanup url key
|
||||
where
|
||||
file' = toRawFilePath file
|
||||
|
||||
|
|
|
@ -50,6 +50,7 @@ import Config.DynamicConfig
|
|||
import Annex.Path
|
||||
import Annex.Wanted
|
||||
import Annex.Content
|
||||
import Annex.WorkTree
|
||||
import Command.Get (getKey')
|
||||
import qualified Command.Move
|
||||
import qualified Command.Export
|
||||
|
@ -765,7 +766,10 @@ seekSyncContent o rs currbranch = do
|
|||
seekHelper fst3 ww LsFiles.inRepoDetails l
|
||||
|
||||
seekincludinghidden origbranch mvar l bloomfeeder =
|
||||
seekFiltered (const (pure True)) (\(si, f) -> ifAnnexed f (commandAction . gofile bloomfeeder mvar si f) noop) $
|
||||
let filterer = \(si, f) -> lookupKey f >>= \case
|
||||
Just k -> (commandAction $ gofile bloomfeeder mvar si f k)
|
||||
Nothing -> noop
|
||||
in seekFiltered (const (pure True)) filterer $
|
||||
seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l
|
||||
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
|
@ -18,6 +18,7 @@ import qualified Database.Keys
|
|||
import Annex.Content
|
||||
import Annex.Init
|
||||
import Annex.CheckIgnore
|
||||
import Annex.WorkTree
|
||||
import Utility.FileMode
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
|
@ -50,13 +51,17 @@ seek ps = do
|
|||
l <- workTreeItems ww ps
|
||||
withFilesNotInGit
|
||||
(CheckGitIgnore False)
|
||||
WarnUnmatchWorkTreeItems
|
||||
(\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f)
|
||||
WarnUnmatchWorkTreeItems
|
||||
checksymlinks
|
||||
l
|
||||
withFilesInGitAnnex ww (Command.Unannex.seeker True) l
|
||||
finish
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
checksymlinks (_, f) =
|
||||
commandAction $ lookupKey f >>= \case
|
||||
Nothing -> stop
|
||||
Just k -> startCheckIncomplete (fromRawFilePath f) k
|
||||
|
||||
{- git annex symlinks that are not checked into git could be left by an
|
||||
- interrupted add. -}
|
||||
|
|
Loading…
Reference in a new issue