Added inprogress command for accessing files as they are being downloaded.
Chose to make this only handle files actively being downloaded, not temp files for downloads that were interrupted or files that have been fully downloaded. This commit was sponsored by Ole-Morten Duesund on Patreon.
This commit is contained in:
parent
d180ae039c
commit
67338fd7ac
6 changed files with 125 additions and 0 deletions
60
Command/Inprogress.hs
Normal file
60
Command/Inprogress.hs
Normal file
|
@ -0,0 +1,60 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2017 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.Inprogress where
|
||||
|
||||
import Command
|
||||
import Annex.Transfer
|
||||
|
||||
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
|
||||
, allOption :: Bool
|
||||
}
|
||||
|
||||
optParser :: CmdParamsDesc -> Parser InprogressOptions
|
||||
optParser desc = InprogressOptions
|
||||
<$> cmdParams desc
|
||||
<*> switch
|
||||
( long "all"
|
||||
<> short 'A'
|
||||
<> help "access all files currently being downloaded"
|
||||
)
|
||||
|
||||
seek :: InprogressOptions -> CommandSeek
|
||||
seek o = do
|
||||
ts <- map (transferKey . fst) <$> getTransfers
|
||||
if allOption o
|
||||
then forM_ ts $ commandAction . start'
|
||||
else do
|
||||
let s = S.fromList ts
|
||||
withFilesInGit (whenAnnexed (start s))
|
||||
=<< workTreeItems (inprogressFiles o)
|
||||
|
||||
start :: S.Set Key -> FilePath -> Key -> CommandStart
|
||||
start s _file k
|
||||
| S.member k s = start' k
|
||||
| otherwise = notInprogress
|
||||
|
||||
start' :: Key -> CommandStart
|
||||
start' k = do
|
||||
tmpf <- fromRepo $ gitAnnexTmpObjectLocation k
|
||||
ifM (liftIO $ doesFileExist tmpf)
|
||||
( next $ next $ do
|
||||
liftIO $ putStrLn tmpf
|
||||
return True
|
||||
, notInprogress
|
||||
)
|
||||
|
||||
notInprogress :: CommandStart
|
||||
notInprogress = next stop
|
Loading…
Add table
Add a link
Reference in a new issue