be36e208c2
When a nonexistant file is passed to a command and --json-error-messages is enabled, output a JSON object indicating the problem. (But git ls-files --error-unmatch still displays errors about such files in some situations.) I don't like the duplication of the name of the command introduced by this, but I can't see a great way around it. One way would be to pass the Command instead. When json is not enabled, the stderr is unchanged. This is necessary because some commands like find have custom output. So dislaying "find foo not found" would be wrong. So had to complicate things with toplevelFileProblem having different output with and without json. When not using --json-error-messages but still using --json, it displays the error to stderr, but does display a json object without the error. It does have an errorid though. Unsure how useful that behavior is. Sponsored-by: Dartmouth College's Datalad project
64 lines
1.8 KiB
Haskell
64 lines
1.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2017 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Inprogress where
|
|
|
|
import Command
|
|
import Annex.Transfer
|
|
import Utility.Terminal
|
|
import Utility.SafeOutput
|
|
|
|
import qualified Data.Set as S
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ noMessages $ command "inprogress" SectionQuery
|
|
"access files while they're being downloaded"
|
|
paramPaths (seek <$$> optParser)
|
|
|
|
data InprogressOptions = InprogressOptions
|
|
{ inprogressFiles :: CmdParams
|
|
, keyOptions :: Maybe KeyOptions
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser InprogressOptions
|
|
optParser desc = InprogressOptions
|
|
<$> cmdParams desc
|
|
<*> optional (parseAllOption <|> parseSpecificKeyOption)
|
|
|
|
seek :: InprogressOptions -> CommandSeek
|
|
seek o = do
|
|
isterminal <- liftIO $ checkIsTerminal stdout
|
|
ts <- map (transferKey . fst) <$> getTransfers
|
|
case keyOptions o of
|
|
Just WantAllKeys ->
|
|
forM_ ts $ commandAction . (start' isterminal)
|
|
Just (WantSpecificKey k)
|
|
| k `elem` ts -> commandAction (start' isterminal k)
|
|
| otherwise -> commandAction stop
|
|
_ -> do
|
|
let s = S.fromList ts
|
|
let seeker = AnnexedFileSeeker
|
|
{ startAction = start isterminal s
|
|
, checkContentPresent = Nothing
|
|
, usesLocationLog = False
|
|
}
|
|
withFilesInGitAnnex ww seeker
|
|
=<< workTreeItems ww (inprogressFiles o)
|
|
where
|
|
ww = WarnUnmatchLsFiles "inprogress"
|
|
|
|
start :: IsTerminal -> S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
|
|
start isterminal s _si _file k
|
|
| S.member k s = start' isterminal k
|
|
| otherwise = stop
|
|
|
|
start' :: IsTerminal -> Key -> CommandStart
|
|
start' (IsTerminal isterminal) k = startingCustomOutput k $ do
|
|
tmpf <- fromRawFilePath <$> fromRepo (gitAnnexTmpObjectLocation k)
|
|
whenM (liftIO $ doesFileExist tmpf) $
|
|
liftIO $ putStrLn (if isterminal then safeOutput tmpf else tmpf)
|
|
next $ return True
|