mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fromkey --json

Browse source 
* fromkey: Added --json.
* fromkey --batch output changed to support using it with --json.
  The old output was not parseable for any useful information, so
  this is not expected to break anything.
This commit is contained in:
Joey Hess 2019-02-05 14:03:29 -04:00
parent 7b46b43c48
commit b080699a95
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 61 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

64
Command/FromKey.hs
View file

@ -19,7 +19,7 @@ import qualified Backend.URL
import Network.URI
cmd :: Command
cmd = notDirect $ notBareRepo $
cmd = notDirect $ notBareRepo $ withGlobalOptions [jsonOptions] $
command "fromkey" SectionPlumbing "adds a file using a specific key"
(paramRepeating (paramPair paramKey paramPath))
(seek <$$> optParser)
@ -36,13 +36,25 @@ optParser desc = FromKeyOptions
seek :: FromKeyOptions -> CommandSeek
seek o = case (batchOption o, keyFilePairs o) of
(Batch fmt, _) -> commandAction $ startMass fmt
(Batch fmt, _) -> seekBatch fmt
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> commandAction $ startMass BatchLine
(NoBatch, []) -> seekBatch BatchLine
(NoBatch, ps) -> do
force <- Annex.getState Annex.force
withPairs (commandAction . start force) ps
seekBatch :: BatchFormat -> CommandSeek
seekBatch fmt = batchInput fmt parse commandAction
where
parse s =
let (keyname, file) = separate (== ' ') s
in if not (null keyname) && not (null file)
then Right $ go file (mkKey keyname)
else Left "Expected pairs of key and filename"
go file key = do
showStart "fromkey" file
next $ perform key file
start :: Bool -> (String, FilePath) -> CommandStart
start force (keyname, file) = do
let key = mkKey keyname
@ -53,22 +65,6 @@ start force (keyname, file) = do
showStart "fromkey" file
next $ perform key file
startMass :: BatchFormat -> CommandStart
startMass fmt = do
showStart' "fromkey" (Just "stdin")
next (massAdd fmt)
massAdd :: BatchFormat -> CommandPerform
massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
where
go status [] = next $ return status
go status ((keyname,f):rest) | not (null keyname) && not (null f) = do
let key = mkKey keyname
ok <- perform' key f
let !status' = status && ok
go status' rest
go _ _ = giveup "Expected pairs of key and file on stdin, but got something else."
-- From user input to a Key.
-- User can input either a serialized key, or an url.
--
@ -85,18 +81,20 @@ mkKey s = case parseURI s of
Nothing -> giveup $ "bad key/url " ++ s
perform :: Key -> FilePath -> CommandPerform
perform key file = do
ok <- perform' key file
next $ return ok
perform' :: Key -> FilePath -> Annex Bool
perform' key file = lookupFileNotHidden file >>= \case
Nothing -> do
link <- calcRepo $ gitAnnexLink file key
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ createSymbolicLink link file
Annex.Queue.addCommand "add" [Param "--"] [file]
return True
perform key file = lookupFileNotHidden file >>= \case
Nothing -> ifM (liftIO $ doesFileExist file)
( hasothercontent
, do
link <- calcRepo $ gitAnnexLink file key
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ createSymbolicLink link file
Annex.Queue.addCommand "add" [Param "--"] [file]
next $ return True
)
Just k
| k == key -> return True
| otherwise -> giveup $ file ++ " already exists with different content"
| k == key -> next $ return True
| otherwise -> hasothercontent
where
hasothercontent = do
warning $ file ++ " already exists with different content"
next $ return False