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

--branch, stage 2

Browse source 
Show branch:file that is being operated on.

I had to make ActionItem a type and not a type class because
withKeyOptions' passed two different types of values when using the type
class, and I could not get the type checker to accept that.
This commit is contained in:
Joey Hess 2016-07-20 15:22:55 -04:00
parent 847944e6b1
commit d13194b230
Failed to extract signature
15 changed files with 145 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Annex/Drop.hs
View file

@ -117,10 +117,10 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
)
dropl fs n = checkdrop fs n Nothing $ \numcopies ->
Command.Drop.startLocal afile numcopies key preverified
Command.Drop.startLocal afile (mkActionItem afile) numcopies key preverified
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
Command.Drop.startRemote afile numcopies key r
Command.Drop.startRemote afile (mkActionItem afile) numcopies key r
slocs = S.fromList locs

38
CmdLine/Seek.hs
View file

@ -4,7 +4,7 @@
- the values a user passes to a command, and prepare actions operating
- on them.
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
- Copyright 2010-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -161,19 +161,29 @@ withNothing _ _ = error "This command takes no parameters."
-
- Otherwise falls back to a regular CommandSeek action on
- whatever params were passed. -}
withKeyOptions :: Maybe KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
withKeyOptions
:: Maybe KeyOptions
-> Bool
-> (Key -> ActionItem -> CommandStart)
-> (CmdParams -> CommandSeek)
-> CmdParams
-> CommandSeek
withKeyOptions ko auto keyaction = withKeyOptions' ko auto mkkeyaction
where
mkkeyaction = do
matcher <- Limit.getMatcher
return $ \getkeys ->
seekActions $ map (process matcher) <$> getkeys
process matcher k = ifM (matcher $ MatchingKey k)
( keyaction k
, return Nothing
)
return $ \k i ->
whenM (matcher $ MatchingKey k) $
commandAction $ keyaction k i
withKeyOptions' :: Maybe KeyOptions -> Bool -> Annex (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
withKeyOptions'
:: Maybe KeyOptions
-> Bool
-> Annex (Key -> ActionItem -> Annex ())
-> (CmdParams
-> CommandSeek)
-> CmdParams
-> CommandSeek
withKeyOptions' ko auto mkkeyaction fallbackaction params = do
bare <- fromRepo Git.repoIsLocalBare
when (auto && bare) $
@ -194,15 +204,17 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
| otherwise = a
incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True
runkeyaction ks = do
runkeyaction getks = do
keyaction <- mkkeyaction
keyaction ks
ks <- getks
forM_ ks $ \k -> keyaction k (mkActionItem k)
runbranchkeys bs = do
keyaction <- mkkeyaction
forM_ bs $ \b -> do
(l, cleanup) <- inRepo $ LsTree.lsTree b
forM_ l $ \i ->
maybe noop (\k -> keyaction (return [k]))
forM_ l $ \i -> do
let bfp = mkActionItem $ BranchFilePath b (LsTree.file i)
maybe noop (\k -> keyaction k bfp)
=<< catKey (LsTree.sha i)
unlessM (liftIO cleanup) $
error ("git ls-tree " ++ Git.fromRef b ++ " failed")

28
Command/Drop.hs
View file

@ -63,36 +63,38 @@ seek o = allowConcurrentOutput $
go = whenAnnexed $ start o
start :: DropOptions -> FilePath -> Key -> CommandStart
start o file key = start' o key (Just file)
start o file key = start' o key afile (mkActionItem afile)
where
afile = Just file
start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
start' o key afile = do
start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart
start' o key afile ai = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
checkDropAuto (autoMode o) from afile key $ \numcopies ->
stopUnless (want from) $
case from of
Nothing -> startLocal afile numcopies key []
Nothing -> startLocal afile ai numcopies key []
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal afile numcopies key []
else startRemote afile numcopies key remote
then startLocal afile ai numcopies key []
else startRemote afile ai numcopies key remote
where
want from
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
startKeys :: DropOptions -> Key -> CommandStart
startKeys :: DropOptions -> Key -> ActionItem -> CommandStart
startKeys o key = start' o key Nothing
startLocal :: AssociatedFile -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
startLocal afile numcopies key preverified = stopUnless (inAnnex key) $ do
showStart' "drop" key afile
startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
showStart' "drop" key ai
next $ performLocal key afile numcopies preverified
startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
startRemote afile numcopies key remote = do
showStart' ("drop " ++ Remote.name remote) key afile
startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
startRemote afile ai numcopies key remote = do
showStart' ("drop " ++ Remote.name remote) key ai
next $ performRemote key afile numcopies remote
performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform

2
Command/DropKey.hs
View file

@ -42,7 +42,7 @@ seek o = do
start :: Key -> CommandStart
start key = do
showStart' "dropkey" key key
showStart' "dropkey" key (mkActionItem key)
next $ perform key
perform :: Key -> CommandPerform

16
Command/Fsck.hs
View file

@ -89,7 +89,7 @@ seek o = allowConcurrentOutput $ do
checkDeadRepo u
i <- prepIncremental u (incrementalOpt o)
withKeyOptions (keyOptions o) False
(\k -> startKey i k =<< getNumCopies)
(\k ai -> startKey i k ai =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
(fsckFiles o)
cleanupIncremental i
@ -111,7 +111,7 @@ start from inc file key = do
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key file backend numcopies r
where
go = runFsck inc file key
go = runFsck inc (mkActionItem (Just file)) key
perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
perform key file backend numcopies = do
@ -173,11 +173,11 @@ performRemote key file backend numcopies remote =
)
dummymeter _ = noop
startKey :: Incremental -> Key -> NumCopies -> CommandStart
startKey inc key numcopies =
startKey :: Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
startKey inc key ai numcopies =
case Backend.maybeLookupBackendName (keyBackendName key) of
Nothing -> stop
Just backend -> runFsck inc (key2file key) key $
Just backend -> runFsck inc ai key $
performKey key backend numcopies
performKey :: Key -> Backend -> NumCopies -> Annex Bool
@ -504,10 +504,10 @@ badContentRemote remote localcopy key = do
(False, True) -> "dropped from " ++ Remote.name remote
(_, False) -> "failed to drop from" ++ Remote.name remote
runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
runFsck inc file key a = ifM (needFsck inc key)
runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
runFsck inc ai key a = ifM (needFsck inc key)
( do
showStart "fsck" file
showStart' "fsck" key ai
next $ do
ok <- a
when ok $

11
Command/Get.hs
View file

@ -49,17 +49,18 @@ seek o = allowConcurrentOutput $ do
(getFiles o)
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
start o from file key = start' expensivecheck from key (Just file)
start o from file key = start' expensivecheck from key afile (mkActionItem afile)
where
afile = Just file
expensivecheck
| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
| otherwise = return True
startKeys :: Maybe Remote -> Key -> CommandStart
startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
startKeys from key = start' (return True) from key Nothing
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $
stopUnless expensivecheck $
case from of
Nothing -> go $ perform key afile
@ -68,7 +69,7 @@ start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
go $ Command.Move.fromPerform src False key afile
where
go a = do
showStart' "get" key afile
showStart' "get" key ai
next a
perform :: Key -> AssociatedFile -> CommandPerform

13
Command/MetaData.hs
View file

@ -69,20 +69,19 @@ seek o = do
(forFiles o)
start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
start now o file = start' (Just file) now o
start now o file k = startKeys now o k (mkActionItem afile)
where
afile = Just file
startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
startKeys = start' Nothing
start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart
start' afile now o k = case getSet o of
startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart
startKeys now o k ai = case getSet o of
Get f -> do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $
putStrLn . fromMetaValue
stop
_ -> do
showStart' "metadata" k afile
showStart' "metadata" k ai
next $ perform now o k
perform :: POSIXTime -> MetaDataOptions -> Key -> CommandPerform

16
Command/Mirror.hs
View file

@ -47,25 +47,27 @@ seek o = allowConcurrentOutput $
(mirrorFiles o)
start :: MirrorOptions -> FilePath -> Key -> CommandStart
start o file = startKey o (Just file)
start o file k = startKey o afile k (mkActionItem afile)
where
afile = Just file
startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart
startKey o afile key = case fromToOptions o of
startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
startKey o afile key ai = case fromToOptions o of
ToRemote r -> ifM (inAnnex key)
( Command.Move.toStart False afile key =<< getParsed r
( Command.Move.toStart False afile key ai =<< getParsed r
, do
numcopies <- getnumcopies
Command.Drop.startRemote afile numcopies key =<< getParsed r
Command.Drop.startRemote afile ai numcopies key =<< getParsed r
)
FromRemote r -> do
haskey <- flip Remote.hasKey key =<< getParsed r
case haskey of
Left _ -> stop
Right True -> Command.Get.start' (return True) Nothing key afile
Right True -> Command.Get.start' (return True) Nothing key afile ai
Right False -> ifM (inAnnex key)
( do
numcopies <- getnumcopies
Command.Drop.startLocal afile numcopies key []
Command.Drop.startLocal afile ai numcopies key []
, stop
)
where

34
Command/Move.hs
View file

@ -51,18 +51,20 @@ seek o = allowConcurrentOutput $
(moveFiles o)
start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
start o move = start' o move . Just
start o move f k = start' o move afile k (mkActionItem afile)
where
afile = Just f
startKey :: MoveOptions -> Bool -> Key -> CommandStart
startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart
startKey o move = start' o move Nothing
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
start' o move afile key =
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
start' o move afile key ai =
case fromToOptions o of
FromRemote src -> fromStart move afile key =<< getParsed src
ToRemote dest -> toStart move afile key =<< getParsed dest
FromRemote src -> fromStart move afile key ai =<< getParsed src
ToRemote dest -> toStart move afile key ai =<< getParsed dest
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
showMoveAction move = showStart' (if move then "move" else "copy")
{- Moves (or copies) the content of an annexed file to a remote.
@ -74,16 +76,16 @@ showMoveAction move = showStart' (if move then "move" else "copy")
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
toStart move afile key dest = do
toStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
toStart move afile key ai dest = do
u <- getUUID
ishere <- inAnnex key
if not ishere || u == Remote.uuid dest
then stop -- not here, so nothing to do
else toStart' dest move afile key
else toStart' dest move afile key ai
toStart' :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
toStart' dest move afile key = do
toStart' :: Remote -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
toStart' dest move afile key ai = do
fast <- Annex.getState Annex.fast
if fast && not move && not (Remote.hasKeyCheap dest)
then ifM (expectedPresent dest key)
@ -93,7 +95,7 @@ toStart' dest move afile key = do
else go False (Remote.hasKey dest key)
where
go fastcheck isthere = do
showMoveAction move key afile
showMoveAction move key ai
next $ toPerform dest move key afile fastcheck =<< isthere
expectedPresent :: Remote -> Key -> Annex Bool
@ -143,13 +145,13 @@ toPerform dest move key afile fastcheck isthere =
- If the current repository already has the content, it is still removed
- from the remote.
-}
fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
fromStart move afile key src
fromStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
fromStart move afile key ai src
| move = go
| otherwise = stopUnless (not <$> inAnnex key) go
where
go = stopUnless (fromOk src key) $ do
showMoveAction move key afile
showMoveAction move key ai
next $ fromPerform src move key afile
fromOk :: Remote -> Key -> Annex Bool

2
Command/SetPresentKey.hs
View file

@ -23,7 +23,7 @@ seek = withWords start
start :: [String] -> CommandStart
start (ks:us:vs:[]) = do
showStart' "setpresentkey" k k
showStart' "setpresentkey" k (mkActionItem k)
next $ perform k (toUUID us) s
where
k = fromMaybe (error "bad key") (file2key ks)

7
Command/Sync.hs
View file

@ -449,8 +449,7 @@ seekSyncContent o rs = do
where
seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=
mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (Just f)) noop)
seekkeys mvar bloom getkeys =
mapM_ (go (Left bloom) mvar Nothing) =<< getkeys
seekkeys mvar bloom k _ = go (Left bloom) mvar Nothing k
go ebloom mvar af k = commandAction $ do
whenM (syncFile ebloom rs af k) $
void $ liftIO $ tryPutMVar mvar ()
@ -512,7 +511,7 @@ syncFile ebloom rs af k = do
, return []
)
get have = includeCommandAction $ do
showStart' "get" k af
showStart' "get" k (mkActionItem af)
next $ next $ getKey' k af have
wantput r
@ -527,4 +526,4 @@ syncFile ebloom rs af k = do
, return []
)
put dest = includeCommandAction $
Command.Move.toStart' dest False af k
Command.Move.toStart' dest False af k (mkActionItem af)

13
Command/Whereis.hs
View file

@ -47,14 +47,13 @@ seek o = do
(whereisFiles o)
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
start remotemap file key = start' remotemap key (Just file)
start remotemap file key = startKeys remotemap key (mkActionItem afile)
where
afile = Just file
startKeys :: M.Map UUID Remote -> Key -> CommandStart
startKeys remotemap key = start' remotemap key Nothing
start' :: M.Map UUID Remote -> Key -> AssociatedFile -> CommandStart
start' remotemap key afile = do
showStart' "whereis" key afile
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
startKeys remotemap key ai = do
showStart' "whereis" key ai
next $ perform remotemap key
perform :: M.Map UUID Remote -> Key -> CommandPerform

9
Git/FilePath.hs
View file

@ -14,6 +14,8 @@
module Git.FilePath (
TopFilePath,
BranchFilePath(..),
descBranchFilePath,
getTopFilePath,
fromTopFilePath,
toTopFilePath,
@ -33,6 +35,13 @@ import qualified System.FilePath.Posix
newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
deriving (Show, Eq, Ord)
{- A file in a branch or other treeish. -}
data BranchFilePath = BranchFilePath Ref TopFilePath
{- Git uses the branch:file form to refer to a BranchFilePath -}
descBranchFilePath :: BranchFilePath -> String
descBranchFilePath (BranchFilePath b f) = fromRef b ++ ':' : getTopFilePath f
{- Path to a TopFilePath, within the provided git repo. -}
fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)

50
Messages.hs
View file

@ -9,6 +9,8 @@
module Messages (
showStart,
ActionItem,
mkActionItem,
showStart',
showNote,
showAction,
@ -50,36 +52,50 @@ import System.Log.Handler.Simple
import Common
import Types
import Types.Messages
import Git.FilePath
import Messages.Internal
import qualified Messages.JSON as JSON
import Types.Key
import qualified Annex
showStart :: String -> FilePath -> Annex ()
showStart command file = outputMessage (JSON.start command (Just file) Nothing) $
showStart command file = outputMessage json $
command ++ " " ++ file ++ " "
where
json = JSON.start command (Just file) Nothing
class ActionItem i where
actionItemDesc :: i -> Key -> String
actionItemWorkTreeFile :: i -> Maybe FilePath
data ActionItem
= ActionItemAssociatedFile AssociatedFile
| ActionItemKey
| ActionItemBranchFilePath BranchFilePath
instance ActionItem FilePath where
actionItemDesc f _ = f
actionItemWorkTreeFile = Just
class MkActionItem t where
mkActionItem :: t -> ActionItem
instance ActionItem AssociatedFile where
actionItemDesc (Just f) _ = f
actionItemDesc Nothing k = key2file k
actionItemWorkTreeFile = id
instance MkActionItem AssociatedFile where
mkActionItem = ActionItemAssociatedFile
instance ActionItem Key where
actionItemDesc k _ = key2file k
actionItemWorkTreeFile _ = Nothing
instance MkActionItem Key where
mkActionItem _ = ActionItemKey
showStart' :: ActionItem i => String -> Key -> i -> Annex ()
showStart' command key i =
outputMessage (JSON.start command (actionItemWorkTreeFile i) (Just key)) $
instance MkActionItem BranchFilePath where
mkActionItem = ActionItemBranchFilePath
actionItemDesc :: ActionItem -> Key -> String
actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
actionItemDesc ActionItemKey k = key2file k
actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
actionItemWorkTreeFile _ = Nothing
showStart' :: String -> Key -> ActionItem -> Annex ()
showStart' command key i = outputMessage json $
command ++ " " ++ actionItemDesc i key ++ " "
where
json = JSON.start command (actionItemWorkTreeFile i) (Just key)
showNote :: String -> Annex ()
showNote s = outputMessage (JSON.note s) $ "(" ++ s ++ ") "

2
doc/todo/operate_on_branch_contents.mdwn
View file

@ -26,3 +26,5 @@ or `refs/tags/*` can be operated on. --[[Joey]]
>> I've implemented the first part of this, so --branch works
>> but the name of the key is shown, rather than the file from the branch.
>> --[[Joey]]
>>> All [[done]] now. --[[Joey]]