c3d40b9ec3
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
58 lines
1.6 KiB
Haskell
58 lines
1.6 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.SetPresentKey where
|
|
|
|
import Command
|
|
import Logs.Location
|
|
import Logs.Presence.Pure
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ withAnnexOptions [jsonOptions] $
|
|
command "setpresentkey" SectionPlumbing
|
|
"change records of where key is present"
|
|
(paramPair paramKey (paramPair paramUUID "[1|0]"))
|
|
(seek <$$> optParser)
|
|
|
|
data SetPresentKeyOptions = SetPresentKeyOptions
|
|
{ params :: CmdParams
|
|
, batchOption :: BatchMode
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser SetPresentKeyOptions
|
|
optParser desc = SetPresentKeyOptions
|
|
<$> cmdParams desc
|
|
<*> parseBatchOption False
|
|
|
|
seek :: SetPresentKeyOptions -> CommandSeek
|
|
seek o = case batchOption o of
|
|
Batch fmt -> batchOnly Nothing (params o) $
|
|
batchInput fmt
|
|
(pure . parseKeyStatus . words)
|
|
(batchCommandAction . uncurry start)
|
|
NoBatch -> either giveup (commandAction . start (SeekInput (params o)))
|
|
(parseKeyStatus $ params o)
|
|
|
|
data KeyStatus = KeyStatus Key UUID LogStatus
|
|
|
|
parseKeyStatus :: [String] -> Either String KeyStatus
|
|
parseKeyStatus (ks:us:vs:[]) = do
|
|
k <- maybe (Left "bad key") Right (deserializeKey ks)
|
|
let u = toUUID us
|
|
s <- maybe (Left "bad value") Right (parseStatus vs)
|
|
return $ KeyStatus k u s
|
|
parseKeyStatus _ = Left "Bad input. Expected: key uuid value"
|
|
|
|
start :: SeekInput -> KeyStatus -> CommandStart
|
|
start si (KeyStatus k u s) = starting "setpresentkey" ai si $ perform k u s
|
|
where
|
|
ai = mkActionItem k
|
|
|
|
perform :: Key -> UUID -> LogStatus -> CommandPerform
|
|
perform k u s = next $ do
|
|
logChange NoLiveUpdate k u s
|
|
return True
|