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

move commandAction out of CmdLine.Seek

Browse source 
This is groundwork for nested seek loops, eg seeking over all files and
then performing commandActions on a list of remotes, which can be done
concurrently.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
This commit is contained in:
Joey Hess 2018-10-01 14:12:06 -04:00
parent 47707608b1
commit 53526136e8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
80 changed files with 169 additions and 156 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
CmdLine/Action.hs
View file

@ -78,6 +78,9 @@ commandAction a = go =<< Annex.getState Annex.concurrency
go NonConcurrent = run
run = void $ includeCommandAction a
commandActions :: [CommandStart] -> Annex ()
commandActions = mapM_ commandAction
{- Waits for any forked off command actions to finish.
-
- Merge together the cleanup actions of all the AnnexStates used by

70
CmdLine/Seek.hs
View file

@ -22,7 +22,6 @@ import qualified Git.LsTree as LsTree
import Git.FilePath
import qualified Limit
import CmdLine.GitAnnex.Options
import CmdLine.Action
import Logs.Location
import Logs.Unused
import Types.Transfer
@ -34,11 +33,11 @@ import Annex.Content
import Annex.InodeSentinal
import qualified Database.Keys
withFilesInGit :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesInGit :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesInGit a l = seekActions $ prepFiltered a $
seekHelper LsFiles.inRepo l
withFilesInGitNonRecursive :: String -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesInGitNonRecursive :: String -> (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesInGitNonRecursive needforce a l = ifM (Annex.getState Annex.force)
( withFilesInGit a l
, if null l
@ -58,7 +57,7 @@ withFilesInGitNonRecursive needforce a l = ifM (Annex.getState Annex.force)
getfiles c ps
_ -> giveup needforce
withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesNotInGit :: Bool -> (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesNotInGit skipdotfiles a l
| skipdotfiles = do
{- dotfiles are not acted on unless explicitly listed -}
@ -78,7 +77,7 @@ withFilesNotInGit skipdotfiles a l
go fs = seekActions $ prepFiltered a $
return $ concat $ segmentPaths (map (\(WorkTreeItem f) -> f) l) fs
withFilesInRefs :: (FilePath -> Key -> CommandStart) -> [Git.Ref] -> CommandSeek
withFilesInRefs :: ((FilePath, Key) -> CommandSeek) -> [Git.Ref] -> CommandSeek
withFilesInRefs a = mapM_ go
where
go r = do
@ -89,16 +88,17 @@ withFilesInRefs a = mapM_ go
catKey (LsTree.sha i) >>= \case
Nothing -> noop
Just k -> whenM (matcher $ MatchingKey k) $
commandAction $ a f k
a (f, k)
liftIO $ void cleanup
withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek
withPathContents :: ((FilePath, FilePath) -> CommandSeek) -> CmdParams -> CommandSeek
withPathContents a params = do
matcher <- Limit.getMatcher
forM_ params $ \p -> do
fs <- liftIO $ get p
forM fs $ \f -> whenM (checkmatch matcher f) $
commandAction (a f)
forM fs $ \f ->
whenM (checkmatch matcher f) $
a f
where
get p = ifM (isDirectory <$> getFileStatus p)
( map (\f -> (f, makeRelative (parentDir p) f))
@ -110,24 +110,24 @@ withPathContents a params = do
, matchFile = relf
}
withWords :: ([String] -> CommandStart) -> CmdParams -> CommandSeek
withWords :: ([String] -> CommandSeek) -> CmdParams -> CommandSeek
withWords a params = seekActions $ return [a params]
withStrings :: (String -> CommandStart) -> CmdParams -> CommandSeek
withStrings :: (String -> CommandSeek) -> CmdParams -> CommandSeek
withStrings a params = seekActions $ return $ map a params
withPairs :: ((String, String) -> CommandStart) -> CmdParams -> CommandSeek
withPairs :: ((String, String) -> CommandSeek) -> CmdParams -> CommandSeek
withPairs a params = seekActions $ return $ map a $ pairs [] params
where
pairs c [] = reverse c
pairs c (x:y:xs) = pairs ((x,y):c) xs
pairs _ _ = giveup "expected pairs"
withFilesToBeCommitted :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesToBeCommitted :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesToBeCommitted a l = seekActions $ prepFiltered a $
seekHelper LsFiles.stagedNotDeleted l
withFilesOldUnlocked :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlocked :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged
{- Unlocked files before v6 have changed type from a symlink to a regular file.
@ -135,7 +135,7 @@ withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged
- Furthermore, unlocked files used to be a git-annex symlink,
- not some other sort of symlink.
-}
withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlocked' typechanged a l = seekActions $
prepFiltered a unlockedfiles
where
@ -145,12 +145,12 @@ isOldUnlocked :: FilePath -> Annex Bool
isOldUnlocked f = liftIO (notSymlink f) <&&>
(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedStaged
{- v6 unlocked pointer files that are staged, and whose content has not been
- modified-}
withUnmodifiedUnlockedPointers :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withUnmodifiedUnlockedPointers :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withUnmodifiedUnlockedPointers a l = seekActions $
prepFiltered a unlockedfiles
where
@ -163,17 +163,17 @@ isV6UnmodifiedUnlocked f = catKeyFile f >>= \case
Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k
{- Finds files that may be modified. -}
withFilesMaybeModified :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
withFilesMaybeModified :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
withFilesMaybeModified a params = seekActions $
prepFiltered a $ seekHelper LsFiles.modified params
withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek
withKeys :: (Key -> CommandSeek) -> CmdParams -> CommandSeek
withKeys a l = seekActions $ return $ map (a . parse) l
where
parse p = fromMaybe (giveup "bad key") $ file2key p
withNothing :: CommandStart -> CmdParams -> CommandSeek
withNothing a [] = seekActions $ return [a]
withNothing :: CommandSeek -> CmdParams -> CommandSeek
withNothing a [] = a
withNothing _ _ = giveup "This command takes no parameters."
{- Handles the --all, --branch, --unused, --failed, --key, and
@ -183,11 +183,12 @@ withNothing _ _ = giveup "This command takes no parameters."
- In a bare repo, --all is the default.
-
- Otherwise falls back to a regular CommandSeek action on
- whatever params were passed. -}
- whatever params were passed.
-}
withKeyOptions
:: Maybe KeyOptions
-> Bool
-> (Key -> ActionItem -> CommandStart)
-> ((Key, ActionItem) -> CommandSeek)
-> ([WorkTreeItem] -> CommandSeek)
-> [WorkTreeItem]
-> CommandSeek
@ -195,14 +196,14 @@ withKeyOptions ko auto keyaction = withKeyOptions' ko auto mkkeyaction
where
mkkeyaction = do
matcher <- Limit.getMatcher
return $ \k i ->
whenM (matcher $ MatchingKey k) $
commandAction $ keyaction k i
return $ \v ->
whenM (matcher $ MatchingKey $ fst v) $
keyaction v
withKeyOptions'
:: Maybe KeyOptions
-> Bool
-> Annex (Key -> ActionItem -> Annex ())
-> Annex ((Key, ActionItem) -> Annex ())
-> ([WorkTreeItem] -> CommandSeek)
-> [WorkTreeItem]
-> CommandSeek
@ -231,14 +232,14 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
keyaction <- mkkeyaction
ks <- getks
forM_ ks $ checker >=> maybe noop
(\k -> keyaction k (mkActionItem k))
(\k -> keyaction (k, mkActionItem k))
runbranchkeys bs = do
keyaction <- mkkeyaction
forM_ bs $ \b -> do
(l, cleanup) <- inRepo $ LsTree.lsTree b
forM_ l $ \i -> do
let bfp = mkActionItem $ BranchFilePath b (LsTree.file i)
maybe noop (\k -> keyaction k bfp)
maybe noop (\k -> keyaction (k, bfp))
=<< catKey (LsTree.sha i)
unlessM (liftIO cleanup) $
error ("git ls-tree " ++ Git.fromRef b ++ " failed")
@ -247,18 +248,17 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
rs <- remoteList
ts <- concat <$> mapM (getFailedTransfers . Remote.uuid) rs
forM_ ts $ \(t, i) ->
keyaction (transferKey t) (mkActionItem (t, i))
keyaction (transferKey t, mkActionItem (t, i))
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
prepFiltered :: (FilePath -> CommandSeek) -> Annex [FilePath] -> Annex [CommandSeek]
prepFiltered a fs = do
matcher <- Limit.getMatcher
map (process matcher) <$> fs
where
process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
( a f , return Nothing )
process matcher f = whenM (matcher $ MatchingFile $ FileInfo f f) $ a f
seekActions :: Annex [CommandStart] -> Annex ()
seekActions gen = mapM_ commandAction =<< gen
seekActions :: Annex [CommandSeek] -> Annex ()
seekActions gen = sequence_ =<< gen
seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [WorkTreeItem] -> Annex [FilePath]
seekHelper a l = inRepo $ \g ->

2
Command/Add.hs
View file

@ -65,7 +65,7 @@ seek o = allowConcurrentOutput $ do
| otherwise -> batchFilesMatching fmt gofile
NoBatch -> do
l <- workTreeItems (addThese o)
let go a = a gofile l
let go a = a (commandAction . gofile) l
unless (updateOnly o) $
go (withFilesNotInGit (not $ includeDotFiles o))
go withFilesMaybeModified

2
Command/Commit.hs
View file

@ -17,7 +17,7 @@ cmd = command "commit" SectionPlumbing
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = next $ next $ do

2
Command/ConfigList.hs
View file

@ -23,7 +23,7 @@ cmd = noCommit $ dontCheck repoExists $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

4
Command/Copy.hs
View file

@ -50,8 +50,8 @@ seek o = allowConcurrentOutput $ do
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o)
(Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
(withFilesInGit go)
(commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
(withFilesInGit $ commandAction . go)
=<< workTreeItems (copyFiles o)
{- A copy is just a move that does not delete the source file.

2
Command/Dead.hs
View file

@ -29,7 +29,7 @@ optParser desc = (DeadRemotes <$> cmdParams desc)
seek :: DeadOptions -> CommandSeek
seek (DeadRemotes rs) = trustCommand "dead" DeadTrusted rs
seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
seek (DeadKeys ks) = commandActions $ map startKey ks
startKey :: Key -> CommandStart
startKey key = do

2
Command/Describe.hs
View file

@ -18,7 +18,7 @@ cmd = command "describe" SectionSetup
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (name:description) = do

2
Command/DiffDriver.hs
View file

@ -19,7 +19,7 @@ cmd = dontCheck repoExists $
("-- cmd --") (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start opts = do

2
Command/Direct.hs
View file

@ -21,7 +21,7 @@ cmd = notBareRepo $ noDaemonRunning $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = ifM versionSupportsDirectMode

8
Command/Drop.hs
View file

@ -56,8 +56,8 @@ seek o = allowConcurrentOutput $
case batchOption o of
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(startKeys o)
(withFilesInGit go)
(commandAction . startKeys o)
(withFilesInGit (commandAction . go))
=<< workTreeItems (dropFiles o)
where
go = whenAnnexed $ start o
@ -84,8 +84,8 @@ start' o key afile ai = do
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
startKeys :: DropOptions -> Key -> ActionItem -> CommandStart
startKeys o key = start' o key (AssociatedFile Nothing)
startKeys :: DropOptions -> (Key, ActionItem) -> CommandStart
startKeys o (key, ai) = start' o key (AssociatedFile Nothing) ai
startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do

2
Command/DropKey.hs
View file

@ -33,7 +33,7 @@ seek :: DropKeyOptions -> CommandSeek
seek o = do
unlessM (Annex.getState Annex.force) $
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
withKeys start (toDrop o)
withKeys (commandAction . start) (toDrop o)
case batchOption o of
Batch fmt -> batchInput fmt parsekey $ batchCommandAction . start
NoBatch -> noop

2
Command/EnableRemote.hs
View file

@ -32,7 +32,7 @@ cmd = command "enableremote" SectionSetup
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = unknownNameError "Specify the remote to enable."

2
Command/EnableTor.hs
View file

@ -36,7 +36,7 @@ cmd = noCommit $ dontCheck repoExists $
"uid" (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
-- This runs as root, so avoid making any commits or initializing
-- git-annex, or doing other things that create root-owned files.

2
Command/Expire.hs
View file

@ -53,7 +53,7 @@ seek o = do
u <- getUUID
us <- filter (/= u) . M.keys <$> uuidMap
descs <- uuidMap
seekActions $ pure $ map (start expire (noActOption o) actlog descs) us
commandActions $ map (start expire (noActOption o) actlog descs) us
start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart
start (Expire expire) noact actlog descs u =

17
Command/Export.hs
View file

@ -99,10 +99,12 @@ changeExport r ea db new = do
-- the next block of code below may have renamed some files to
-- temp files. Diff from the incomplete tree to the new tree,
-- and delete any temp files that the new tree can't use.
let recover diff = commandAction $
startRecoverIncomplete r ea db
(Git.DiffTree.srcsha diff)
(Git.DiffTree.file diff)
forM_ (concatMap incompleteExportedTreeish old) $ \incomplete ->
mapdiff (\diff -> startRecoverIncomplete r ea db (Git.DiffTree.srcsha diff) (Git.DiffTree.file diff))
incomplete
new
mapdiff recover incomplete new
-- Diff the old and new trees, and delete or rename to new name all
-- changed files in the export. After this, every file that remains
@ -115,13 +117,14 @@ changeExport r ea db new = do
[] -> updateExportTree db emptyTree new
[oldtreesha] -> do
diffmap <- mkDiffMap oldtreesha new db
let seekdiffmap a = seekActions $ pure $ map a (M.toList diffmap)
let seekdiffmap a = commandActions $
map a (M.toList diffmap)
-- Rename old files to temp, or delete.
seekdiffmap $ \(ek, (moldf, mnewf)) -> do
case (moldf, mnewf) of
(Just oldf, Just _newf) ->
startMoveToTempName r ea db oldf ek
(Just oldf, Nothing) ->
(Just oldf, Nothing) ->
startUnexport' r ea db oldf ek
_ -> stop
-- Rename from temp to new files.
@ -144,7 +147,7 @@ changeExport r ea db new = do
-- Don't rename to temp, because the
-- content is unknown; delete instead.
mapdiff
(\diff -> startUnexport r ea db (Git.DiffTree.file diff) (unexportboth diff))
(\diff -> commandAction $ startUnexport r ea db (Git.DiffTree.file diff) (unexportboth diff))
oldtreesha new
updateExportTree db emptyTree new
liftIO $ recordExportTreeCurrent db new
@ -194,7 +197,7 @@ fillExport :: Remote -> ExportActions Annex -> ExportHandle -> Git.Ref -> Annex
fillExport r ea db new = do
(l, cleanup) <- inRepo $ Git.LsTree.lsTree new
cvar <- liftIO $ newMVar False
seekActions $ pure $ map (startExport r ea db cvar) l
commandActions $ map (startExport r ea db cvar) l
void $ liftIO $ cleanup
liftIO $ takeMVar cvar

3
Command/Find.hs
View file

@ -50,7 +50,8 @@ parseFormatOption =
seek :: FindOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> withFilesInGit go =<< workTreeItems (findThese o)
NoBatch -> withFilesInGit (commandAction . go)
=<< workTreeItems (findThese o)
Batch fmt -> batchFilesMatching fmt go
where
go = whenAnnexed $ start o

3
Command/FindRef.hs
View file

@ -18,4 +18,5 @@ cmd = withGlobalOptions [nonWorkTreeMatchingOptions] $ Find.mkCommand $
paramRef (seek <$$> Find.optParser)
seek :: Find.FindOptions -> CommandSeek
seek o = Find.start o `withFilesInRefs` (map Git.Ref $ Find.findThese o)
seek o = (commandAction . uncurry (Find.start o))
`withFilesInRefs` (map Git.Ref $ Find.findThese o)

5
Command/Fix.hs
View file

@ -34,8 +34,9 @@ seek ps = unlessM crippledFileSystem $ do
( return FixAll
, return FixSymlinks
)
l <- workTreeItems ps
flip withFilesInGit l $ whenAnnexed $ start fixwhat
withFilesInGit
(commandAction . (whenAnnexed $ start fixwhat))
=<< workTreeItems ps
data FixWhat = FixSymlinks | FixAll

6
Command/FromKey.hs
View file

@ -35,12 +35,12 @@ optParser desc = FromKeyOptions
seek :: FromKeyOptions -> CommandSeek
seek o = case (batchOption o, keyFilePairs o) of
(Batch fmt, _) -> withNothing (startMass fmt) []
(Batch fmt, _) -> commandAction $ startMass fmt
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> withNothing (startMass BatchLine) []
(NoBatch, []) -> commandAction $ startMass BatchLine
(NoBatch, ps) -> do
force <- Annex.getState Annex.force
withPairs (start force) ps
withPairs (commandAction . start force) ps
start :: Bool -> (String, FilePath) -> CommandStart
start force (keyname, file) = do

8
Command/Fsck.hs
View file

@ -94,8 +94,8 @@ seek o = allowConcurrentOutput $ do
checkDeadRepo u
i <- prepIncremental u (incrementalOpt o)
withKeyOptions (keyOptions o) False
(\k ai -> startKey from i k ai =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
(\kai -> commandAction . startKey from i kai =<< getNumCopies)
(withFilesInGit $ commandAction . (whenAnnexed (start from i)))
=<< workTreeItems (fsckFiles o)
cleanupIncremental i
void $ tryIO $ recordActivity Fsck u
@ -183,8 +183,8 @@ performRemote key afile backend numcopies remote =
)
dummymeter _ = noop
startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
startKey from inc key ai numcopies =
startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart
startKey from inc (key, ai) numcopies =
case Backend.maybeLookupBackendVariety (keyVariety key) of
Nothing -> stop
Just backend -> runFsck inc ai key $

2
Command/FuzzTest.hs
View file

@ -26,7 +26,7 @@ cmd = notBareRepo $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

2
Command/GCryptSetup.hs
View file

@ -19,7 +19,7 @@ cmd = dontCheck repoExists $ noCommit $
paramValue (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withStrings start
seek = withStrings (commandAction . start)
start :: String -> CommandStart
start gcryptid = next $ next $ do

8
Command/Get.hs
View file

@ -44,8 +44,8 @@ seek o = allowConcurrentOutput $ do
case batchOption o of
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(startKeys from)
(withFilesInGit go)
(commandAction . startKeys from)
(withFilesInGit (commandAction . go))
=<< workTreeItems (getFiles o)
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
@ -57,8 +57,8 @@ start o from file key = start' expensivecheck from key afile (mkActionItem afile
<||> wantGet False (Just key) afile
| otherwise = return True
startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
startKeys from key ai = checkFailedTransferDirection ai Download $
startKeys :: Maybe Remote -> (Key, ActionItem) -> CommandStart
startKeys from (key, ai) = checkFailedTransferDirection ai Download $
start' (return True) from key (AssociatedFile Nothing) ai
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart

2
Command/Group.hs
View file

@ -19,7 +19,7 @@ cmd = noMessages $ command "group" SectionSetup "add a repository to a group"
(paramPair paramRemote paramDesc) (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (name:g:[]) = do

2
Command/GroupWanted.hs
View file

@ -18,7 +18,7 @@ cmd = noMessages $ command "groupwanted" SectionSetup
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (g:[]) = next $ performGet groupPreferredContentMapRaw g

2
Command/Help.hs
View file

@ -27,7 +27,7 @@ cmd = noCommit $ dontCheck repoExists $
parseparams = withParams
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start params = do

3
Command/Import.hs
View file

@ -73,7 +73,8 @@ seek o = allowConcurrentOutput $ do
unless (null inrepops) $ do
giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
largematcher <- largeFilesMatcher
withPathContents (start largematcher (duplicateMode o)) (importFiles o)
(commandAction . start largematcher (duplicateMode o))
`withPathContents` importFiles o
start :: GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart
start largematcher mode (srcfile, destfile) =

2
Command/ImportFeed.hs
View file

@ -67,7 +67,7 @@ optParser desc = ImportFeedOptions
seek :: ImportFeedOptions -> CommandSeek
seek o = do
cache <- getCache (templateOption o)
withStrings (start o cache) (feedUrls o)
withStrings (commandAction . start o cache) (feedUrls o)
start :: ImportFeedOptions -> Cache -> URLString -> CommandStart
start opts cache url = do

2
Command/InAnnex.hs
View file

@ -18,7 +18,7 @@ cmd = noCommit $
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withKeys start
seek = withKeys (commandAction . start)
start :: Key -> CommandStart
start key = inAnnexSafe key >>= dispatch

2
Command/Indirect.hs
View file

@ -27,7 +27,7 @@ cmd = notBareRepo $ noDaemonRunning $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = ifM isDirect

2
Command/Info.hs
View file

@ -132,7 +132,7 @@ optParser desc = InfoOptions
seek :: InfoOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> withWords (start o) (infoFor o)
NoBatch -> withWords (commandAction . start o) (infoFor o)
Batch fmt -> batchInput fmt Right (itemInfo o)
start :: InfoOptions -> [String] -> CommandStart

2
Command/InitRemote.hs
View file

@ -24,7 +24,7 @@ cmd = command "initremote" SectionSetup
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = giveup "Specify a name for the remote."

3
Command/Inprogress.hs
View file

@ -38,7 +38,8 @@ seek o = do
then forM_ ts $ commandAction . start'
else do
let s = S.fromList ts
withFilesInGit (whenAnnexed (start s))
withFilesInGit
(commandAction . (whenAnnexed (start s)))
=<< workTreeItems (inprogressFiles o)
start :: S.Set Key -> FilePath -> Key -> CommandStart

3
Command/List.hs
View file

@ -44,7 +44,8 @@ seek :: ListOptions -> CommandSeek
seek o = do
list <- getList o
printHeader list
withFilesInGit (whenAnnexed $ start list)
withFilesInGit
(commandAction . (whenAnnexed $ start list))
=<< workTreeItems (listThese o)
getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]

6
Command/Lock.hs
View file

@ -32,10 +32,10 @@ seek :: CmdParams -> CommandSeek
seek ps = do
l <- workTreeItems ps
ifM versionSupportsUnlockedPointers
( withFilesInGit (whenAnnexed startNew) l
( withFilesInGit (commandAction . (whenAnnexed startNew)) l
, do
withFilesOldUnlocked startOld l
withFilesOldUnlockedToBeCommitted startOld l
withFilesOldUnlocked (commandAction . startOld) l
withFilesOldUnlockedToBeCommitted (commandAction . startOld) l
)
startNew :: FilePath -> Key -> CommandStart

2
Command/LockContent.hs
View file

@ -20,7 +20,7 @@ cmd = noCommit $
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
-- First, lock the content, then print out "OK".
-- Wait for the caller to send a line before dropping the lock.

3
Command/Log.hs
View file

@ -91,7 +91,8 @@ seek o = do
zone <- liftIO getCurrentTimeZone
let outputter = mkOutputter m zone o
case (logFiles o, allOption o) of
(fs, False) -> withFilesInGit (whenAnnexed $ start o outputter)
(fs, False) -> withFilesInGit
(commandAction . (whenAnnexed $ start o outputter))
=<< workTreeItems fs
([], True) -> commandAction (startAll o outputter)
(_, True) -> giveup "Cannot specify both files and --all"

2
Command/Map.hs
View file

@ -37,7 +37,7 @@ cmd = dontCheck repoExists $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

10
Command/MetaData.hs
View file

@ -80,8 +80,8 @@ seek o = case batchOption o of
Set _ -> withFilesInGitNonRecursive
"Not recursively setting metadata. Use --force to do that."
withKeyOptions (keyOptions o) False
(startKeys c o)
(seeker $ whenAnnexed $ start c o)
(commandAction . startKeys c o)
(seeker (commandAction . (whenAnnexed (start c o))))
=<< workTreeItems (forFiles o)
Batch fmt -> withMessageState $ \s -> case outputType s of
JSONOutput _ -> ifM limited
@ -92,12 +92,12 @@ seek o = case batchOption o of
_ -> giveup "--batch is currently only supported in --json mode"
start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart
start c o file k = startKeys c o k (mkActionItem afile)
start c o file k = startKeys c o (k, mkActionItem afile)
where
afile = AssociatedFile (Just file)
startKeys :: VectorClock -> MetaDataOptions -> Key -> ActionItem -> CommandStart
startKeys c o k ai = case getSet o of
startKeys :: VectorClock -> MetaDataOptions -> (Key, ActionItem) -> CommandStart
startKeys c o (k, ai) = case getSet o of
Get f -> do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $

2
Command/Migrate.hs
View file

@ -26,7 +26,7 @@ cmd = notDirect $ withGlobalOptions [annexedMatchingOptions] $
paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = withFilesInGit (whenAnnexed start) =<< workTreeItems ps
seek = withFilesInGit (commandAction . (whenAnnexed start)) <=< workTreeItems
start :: FilePath -> Key -> CommandStart
start file key = do

10
Command/Mirror.hs
View file

@ -43,17 +43,17 @@ instance DeferredParseClass MirrorOptions where
seek :: MirrorOptions -> CommandSeek
seek o = allowConcurrentOutput $
withKeyOptions (keyOptions o) False
(startKey o (AssociatedFile Nothing))
(withFilesInGit $ whenAnnexed $ start o)
(commandAction . startKey o (AssociatedFile Nothing))
(withFilesInGit (commandAction . (whenAnnexed $ start o)))
=<< workTreeItems (mirrorFiles o)
start :: MirrorOptions -> FilePath -> Key -> CommandStart
start o file k = startKey o afile k (mkActionItem afile)
start o file k = startKey o afile (k, mkActionItem afile)
where
afile = AssociatedFile (Just file)
startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart
startKey o afile key ai = onlyActionOn key $ case fromToOptions o of
startKey :: MirrorOptions -> AssociatedFile -> (Key, ActionItem) -> CommandStart
startKey o afile (key, ai) = onlyActionOn key $ case fromToOptions o of
ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
( Command.Move.toStart Command.Move.RemoveNever afile key ai =<< getParsed r
, do

9
Command/Move.hs
View file

@ -59,8 +59,8 @@ seek o = allowConcurrentOutput $ do
case batchOption o of
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) False
(startKey (fromToOptions o) (removeWhen o))
(withFilesInGit go)
(commandAction . startKey (fromToOptions o) (removeWhen o))
(withFilesInGit (commandAction . go))
=<< workTreeItems (moveFiles o)
start :: FromToHereOptions -> RemoveWhen -> FilePath -> Key -> CommandStart
@ -69,8 +69,9 @@ start fromto removewhen f k =
where
afile = AssociatedFile (Just f)
startKey :: FromToHereOptions -> RemoveWhen -> Key -> ActionItem -> CommandStart
startKey fromto removewhen = start' fromto removewhen (AssociatedFile Nothing)
startKey :: FromToHereOptions -> RemoveWhen -> (Key, ActionItem) -> CommandStart
startKey fromto removewhen =
uncurry $ start' fromto removewhen (AssociatedFile Nothing)
start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
start' fromto removewhen afile key ai = onlyActionOn key $

2
Command/NotifyChanges.hs
View file

@ -21,7 +21,7 @@ cmd = noCommit $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = go =<< watchChangedRefs

2
Command/NumCopies.hs
View file

@ -17,7 +17,7 @@ cmd = noMessages $ command "numcopies" SectionSetup
paramNumber (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = startGet

6
Command/PreCommit.hs
View file

@ -39,7 +39,7 @@ seek :: CmdParams -> CommandSeek
seek ps = lockPreCommitHook $ ifM isDirect
( do
-- update direct mode mappings for committed files
withWords startDirect ps
withWords (commandAction . startDirect) ps
runAnnexHook preCommitAnnexHook
, do
ifM (not <$> versionSupportsUnlockedPointers <&&> liftIO Git.haveFalseIndex)
@ -51,14 +51,14 @@ seek ps = lockPreCommitHook $ ifM isDirect
, do
l <- workTreeItems ps
-- fix symlinks to files being committed
flip withFilesToBeCommitted l $ \f ->
flip withFilesToBeCommitted l $ \f -> commandAction $
maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)
=<< isAnnexLink f
-- inject unlocked files into the annex
-- (not needed when repo version uses
-- unlocked pointer files)
unlessM versionSupportsUnlockedPointers $
withFilesOldUnlockedToBeCommitted startInjectUnlocked l
withFilesOldUnlockedToBeCommitted (commandAction . startInjectUnlocked) l
)
runAnnexHook preCommitAnnexHook
-- committing changes to a view updates metadata

2
Command/Proxy.hs
View file

@ -27,7 +27,7 @@ cmd = notBareRepo $
("-- git command") (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = giveup "Did not specify command to run."

2
Command/ReKey.hs
View file

@ -50,7 +50,7 @@ batchParser s = case separate (== ' ') (reverse s) of
seek :: ReKeyOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
NoBatch -> withPairs (start . parsekey) (reKeyThese o)
NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
where
parsekey (file, skey) =
(file, fromMaybe (giveup "bad key") (file2key skey))

2
Command/ReadPresentKey.hs
View file

@ -18,7 +18,7 @@ cmd = noCommit $
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (ks:us:[]) = do

2
Command/RecvKey.hs
View file

@ -23,7 +23,7 @@ cmd = noCommit $ command "recvkey" SectionPlumbing
paramKey (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withKeys start
seek = withKeys (commandAction . start)
start :: Key -> CommandStart
start key = fieldTransfer Download key $ \_p -> do

6
Command/RegisterUrl.hs
View file

@ -33,10 +33,10 @@ optParser desc = RegisterUrlOptions
seek :: RegisterUrlOptions -> CommandSeek
seek o = case (batchOption o, keyUrlPairs o) of
(Batch fmt, _) -> withNothing (startMass fmt) []
(Batch fmt, _) -> commandAction $ startMass fmt
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> withNothing (startMass BatchLine) []
(NoBatch, ps) -> withWords start ps
(NoBatch, []) -> commandAction $ startMass BatchLine
(NoBatch, ps) -> withWords (commandAction . start) ps
start :: [String] -> CommandStart
start (keyname:url:[]) = do

2
Command/Reinit.hs
View file

@ -21,7 +21,7 @@ cmd = dontCheck repoExists $
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start ws = do

4
Command/Reinject.hs
View file

@ -35,8 +35,8 @@ optParser desc = ReinjectOptions
seek :: ReinjectOptions -> CommandSeek
seek os
| knownOpt os = withStrings startKnown (params os)
| otherwise = withWords startSrcDest (params os)
| knownOpt os = withStrings (commandAction . startKnown) (params os)
| otherwise = withWords (commandAction . startSrcDest) (params os)
startSrcDest :: [FilePath] -> CommandStart
startSrcDest (src:dest:[])

2
Command/Repair.hs
View file

@ -22,7 +22,7 @@ cmd = noCommit $ dontCheck repoExists $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = next $ next $ runRepair =<< Annex.getState Annex.force

2
Command/ResolveMerge.hs
View file

@ -19,7 +19,7 @@ cmd = command "resolvemerge" SectionPlumbing
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

2
Command/RmUrl.hs
View file

@ -31,7 +31,7 @@ optParser desc = RmUrlOptions
seek :: RmUrlOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
NoBatch -> withPairs start (rmThese o)
NoBatch -> withPairs (commandAction . start) (rmThese o)
-- Split on the last space, since a FilePath can contain whitespace,
-- but a url should not.

2
Command/Schedule.hs
View file

@ -20,7 +20,7 @@ cmd = noMessages $ command "schedule" SectionSetup "get or set scheduled jobs"
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start = parse

2
Command/SendKey.hs
View file

@ -24,7 +24,7 @@ cmd = noCommit $
paramKey (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withKeys start
seek = withKeys (commandAction . start)
start :: Key -> CommandStart
start key = do

2
Command/SetKey.hs
View file

@ -17,7 +17,7 @@ cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (keyname:file:[]) = do

2
Command/Status.hs
View file

@ -37,7 +37,7 @@ optParser desc = StatusOptions
))
seek :: StatusOptions -> CommandSeek
seek o = withWords (start o) (statusFiles o)
seek o = withWords (commandAction . start o) (statusFiles o)
start :: StatusOptions -> [FilePath] -> CommandStart
start o locs = do

2
Command/Sync.hs
View file

@ -595,7 +595,7 @@ seekSyncContent o rs = do
where
seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=
mapM_ (\f -> ifAnnexed f (go (Right bloomfeeder) mvar (AssociatedFile (Just f))) noop)
seekkeys mvar bloom k _ = go (Left bloom) mvar (AssociatedFile Nothing) k
seekkeys mvar bloom (k, _) = go (Left bloom) mvar (AssociatedFile Nothing) k
go ebloom mvar af k = commandAction $ do
whenM (syncFile ebloom rs af k) $
void $ liftIO $ tryPutMVar mvar ()

2
Command/TransferInfo.hs
View file

@ -22,7 +22,7 @@ cmd = noCommit $
paramKey (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
{- Security:
-

2
Command/TransferKey.hs
View file

@ -42,7 +42,7 @@ instance DeferredParseClass TransferKeyOptions where
<*> pure (fileOption v)
seek :: TransferKeyOptions -> CommandSeek
seek o = withKeys (start o) (keyOptions o)
seek o = withKeys (commandAction . start o) (keyOptions o)
start :: TransferKeyOptions -> Key -> CommandStart
start o key = case fromToOptions o of

2
Command/TransferKeys.hs
View file

@ -25,7 +25,7 @@ cmd = command "transferkeys" SectionPlumbing "transfers keys"
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

2
Command/Trust.hs
View file

@ -23,7 +23,7 @@ seek :: CmdParams -> CommandSeek
seek = trustCommand "trust" Trusted
trustCommand :: String -> TrustLevel -> CmdParams -> CommandSeek
trustCommand c level = withWords start
trustCommand c level = withWords (commandAction . start)
where
start ws = do
let name = unwords ws

2
Command/Unannex.hs
View file

@ -31,7 +31,7 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
seek :: CmdParams -> CommandSeek
seek ps = wrapUnannex $
(withFilesInGit $ whenAnnexed start) =<< workTreeItems ps
(withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps
wrapUnannex :: Annex a -> Annex a
wrapUnannex a = ifM (versionSupportsUnlockedPointers <||> isDirect)

2
Command/Undo.hs
View file

@ -43,7 +43,7 @@ seek ps = do
void $ Command.Sync.commitStaged Git.Branch.ManualCommit
"commit before undo"
withStrings start ps
withStrings (commandAction . start) ps
start :: FilePath -> CommandStart
start p = do

2
Command/Ungroup.hs
View file

@ -19,7 +19,7 @@ cmd = command "ungroup" SectionSetup "remove a repository from a group"
(paramPair paramRemote paramDesc) (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (name:g:[]) = do

4
Command/Uninit.hs
View file

@ -41,9 +41,9 @@ check = do
seek :: CmdParams -> CommandSeek
seek ps = do
l <- workTreeItems ps
withFilesNotInGit False (whenAnnexed startCheckIncomplete) l
withFilesNotInGit False (commandAction . whenAnnexed startCheckIncomplete) l
Annex.changeState $ \s -> s { Annex.fast = True }
withFilesInGit (whenAnnexed Command.Unannex.start) l
withFilesInGit (commandAction . whenAnnexed Command.Unannex.start) l
finish
{- git annex symlinks that are not checked into git could be left by an

2
Command/Unlock.hs
View file

@ -30,7 +30,7 @@ mkcmd n d = notDirect $
command n SectionCommon d paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek ps = withFilesInGit (whenAnnexed start) =<< workTreeItems ps
seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps
{- Before v6, the unlock subcommand replaces the symlink with a copy of
- the file's content. In v6 and above, it converts the file from a symlink

3
Command/Unused.hs
View file

@ -303,8 +303,7 @@ withUnusedMaps a params = do
unusedtmp <- readUnusedMap "tmp"
let m = unused `M.union` unusedbad `M.union` unusedtmp
let unusedmaps = UnusedMaps unused unusedbad unusedtmp
seekActions $ return $ map (a unusedmaps) $
concatMap (unusedSpec m) params
commandActions $ map (a unusedmaps) $ concatMap (unusedSpec m) params
unusedSpec :: UnusedMap -> String -> [Int]
unusedSpec m spec

2
Command/Upgrade.hs
View file

@ -19,7 +19,7 @@ cmd = dontCheck repoExists $ -- because an old version may not seem to exist
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

2
Command/VAdd.hs
View file

@ -19,7 +19,7 @@ cmd = notBareRepo $ notDirect $
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start params = do

2
Command/VCycle.hs
View file

@ -20,7 +20,7 @@ cmd = notBareRepo $ notDirect $
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start ::CommandStart
start = go =<< currentView

2
Command/VFilter.hs
View file

@ -17,7 +17,7 @@ cmd = notBareRepo $ notDirect $
paramView (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start params = do

2
Command/VPop.hs
View file

@ -21,7 +21,7 @@ cmd = notBareRepo $ notDirect $
paramNumber (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start ps = go =<< currentView

2
Command/Vicfg.hs
View file

@ -37,7 +37,7 @@ cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
seek = withNothing (commandAction start)
start :: CommandStart
start = do

2
Command/View.hs
View file

@ -25,7 +25,7 @@ cmd = notBareRepo $ notDirect $
paramView (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = giveup "Specify metadata to include in view"

2
Command/Wanted.hs
View file

@ -30,7 +30,7 @@ cmd' name desc getter setter = noMessages $
where
pdesc = paramPair paramRemote (paramOptional paramExpression)
seek = withWords start
seek = withWords (commandAction . start)
start (rname:[]) = go rname (performGet getter)
start (rname:expr:[]) = go rname $ \uuid -> do

10
Command/Whereis.hs
View file

@ -43,17 +43,17 @@ seek o = do
Batch fmt -> batchFilesMatching fmt go
NoBatch ->
withKeyOptions (keyOptions o) False
(startKeys m)
(withFilesInGit go)
(commandAction . startKeys m)
(withFilesInGit (commandAction . go))
=<< workTreeItems (whereisFiles o)
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
start remotemap file key = startKeys remotemap key (mkActionItem afile)
start remotemap file key = startKeys remotemap (key, mkActionItem afile)
where
afile = AssociatedFile (Just file)
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
startKeys remotemap key ai = do
startKeys :: M.Map UUID Remote -> (Key, ActionItem) -> CommandStart
startKeys remotemap (key, ai) = do
showStartKey "whereis" key ai
next $ perform remotemap key