diffdriver: Added --get option

Removed the dontCheck repoExists, because running it in a repo that has not
been initialized yet would update location log with nouuid. And I guess
it's ok for it to only support running in git-annex repos.
This commit is contained in:
Joey Hess 2023-08-22 11:58:13 -04:00
parent 724ceeb1a9
commit 379d58b499
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 42 additions and 20 deletions

View file

@ -11,15 +11,16 @@ import Command
import Annex.Content
import Annex.Link
import Git.Types
import qualified Command.Get
cmd :: Command
cmd = dontCheck repoExists $
command "diffdriver" SectionPlumbing
"git diff driver"
("-- cmd --") (seek <$$> optParser)
cmd = command "diffdriver" SectionPlumbing
"git diff driver"
("-- cmd --") (seek <$$> optParser)
data Options = Options
{ textDiff :: Bool
, getOption :: Bool
, restOptions :: CmdParams
}
@ -29,16 +30,16 @@ optParser desc = Options
( long "text"
<> help "diff text files with diff(1)"
)
<*> switch
( long "get"
<> help "get file contents from remotes"
)
<*> cmdParams desc
seek :: Options -> CommandSeek
seek = commandAction . start
start :: Options -> CommandStart
start opts = do
seek opts = do
let (req, differ) = parseReq opts
void $ liftIO . exitBool =<< liftIO . differ =<< fixupReq req
stop
void $ liftIO . exitBool =<< liftIO . differ =<< fixupReq req opts
data Req
= Req
@ -99,22 +100,35 @@ parseReq opts
-
- In either case, adjust the Req to instead point to the actual
- location of the annexed object (which may or may not be present).
-
- This also gets objects from remotes when the getOption is set.
-}
fixupReq :: Req -> Annex Req
fixupReq req@(UnmergedReq {}) = return req
fixupReq req@(Req {}) =
fixupReq :: Req -> Options -> Annex Req
fixupReq req@(UnmergedReq {}) _ = return req
fixupReq req@(Req {}) opts =
check rOldFile rOldMode (\r f -> r { rOldFile = f }) req
>>= check rNewFile rNewMode (\r f -> r { rNewFile = f })
where
check getfile getmode setfile r = case readTreeItemType (encodeBS (getmode r)) of
Just TreeSymlink -> do
v <- getAnnexLinkTarget' f False
maybe (return r) repoint (parseLinkTargetOrPointer =<< v)
_ -> maybe (return r) repoint =<< liftIO (isPointerFile f)
maybe (return r) go (parseLinkTargetOrPointer =<< v)
_ -> maybe (return r) go =<< liftIO (isPointerFile f)
where
f = toRawFilePath (getfile r)
go k = do
when (getOption opts) $
unlessM (inAnnex k) $
commandAction $
starting "get" ai si $
Command.Get.perform k af
repoint k
where
ai = OnlyActionOn k (ActionItemKey k)
si = SeekInput []
af = AssociatedFile (Just f)
repoint k = withObjectLoc k $
pure . setfile r . fromRawFilePath
f = toRawFilePath (getfile r)
externalDiffer :: String -> [String] -> Differ
externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req )