4e7e1fcff4
Needed to run youtube-dl in, but could also be useful for other stuff. The tricky part of this was making the workdir be cleaned up whenever the tmp object file is cleaned up. This commit was sponsored by Ole-Morten Duesund on Patreon.
59 lines
1.7 KiB
Haskell
59 lines
1.7 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.DropUnused where
|
|
|
|
import Command
|
|
import qualified Command.Drop
|
|
import qualified Remote
|
|
import qualified Git
|
|
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
|
import Annex.NumCopies
|
|
import Annex.Content
|
|
|
|
cmd :: Command
|
|
cmd = command "dropunused" SectionMaintenance
|
|
"drop unused file content"
|
|
(paramRepeating paramNumRange) (seek <$$> optParser)
|
|
|
|
data DropUnusedOptions = DropUnusedOptions
|
|
{ rangesToDrop :: CmdParams
|
|
, dropFrom :: Maybe (DeferredParse Remote)
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser DropUnusedOptions
|
|
optParser desc = DropUnusedOptions
|
|
<$> cmdParams desc
|
|
<*> optional (Command.Drop.parseDropFromOption)
|
|
|
|
seek :: DropUnusedOptions -> CommandSeek
|
|
seek o = do
|
|
numcopies <- getNumCopies
|
|
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
|
|
withUnusedMaps (start from numcopies) (rangesToDrop o)
|
|
|
|
start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
|
|
start from numcopies = startUnused "dropunused"
|
|
(perform from numcopies)
|
|
(performOther gitAnnexBadLocation)
|
|
(performOther gitAnnexTmpObjectLocation)
|
|
|
|
perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
|
|
perform from numcopies key = case from of
|
|
Just r -> do
|
|
showAction $ "from " ++ Remote.name r
|
|
Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r
|
|
Nothing -> ifM (inAnnex key)
|
|
( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
|
|
, next (return True)
|
|
)
|
|
|
|
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
|
|
performOther filespec key = do
|
|
f <- fromRepo $ filespec key
|
|
pruneTmpWorkDirBefore f (liftIO . nukeFile)
|
|
next $ return True
|