Merge branch 'master' into concurrentprogress
Conflicts: Command/Fsck.hs Messages.hs Remote/Directory.hs Remote/Git.hs Remote/Helper/Special.hs Types/Remote.hs debian/changelog git-annex.cabal
This commit is contained in:
commit
e27b97d364
378 changed files with 4978 additions and 1158 deletions
|
@ -5,8 +5,6 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module CmdLine.Action where
|
||||
|
||||
import Common.Annex
|
||||
|
@ -119,14 +117,11 @@ includeCommandAction a = account =<< tryIO go
|
|||
account (Right True) = return True
|
||||
account (Right False) = incerr
|
||||
account (Left err) = do
|
||||
showErr err
|
||||
toplevelWarning True (show err)
|
||||
showEndFail
|
||||
incerr
|
||||
incerr = do
|
||||
Annex.changeState $ \s ->
|
||||
let ! c = Annex.errcounter s + 1
|
||||
! s' = s { Annex.errcounter = c }
|
||||
in s'
|
||||
Annex.incError
|
||||
return False
|
||||
|
||||
{- Runs a single command action through the start, perform and cleanup
|
||||
|
|
41
CmdLine/Batch.hs
Normal file
41
CmdLine/Batch.hs
Normal file
|
@ -0,0 +1,41 @@
|
|||
{- git-annex batch commands
|
||||
-
|
||||
- Copyright 2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module CmdLine.Batch where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
|
||||
batchOption :: Option
|
||||
batchOption = flagOption [] "batch" "enable batch mode"
|
||||
|
||||
data BatchMode = Batch | NoBatch
|
||||
type Batchable t = BatchMode -> t -> CommandStart
|
||||
|
||||
-- A Batchable command can run in batch mode, or not.
|
||||
-- In batch mode, one line at a time is read, parsed, and a reply output to
|
||||
-- stdout. In non batch mode, the command's parameters are parsed and
|
||||
-- a reply output for each.
|
||||
batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek
|
||||
batchable seeker starter params = ifM (getOptionFlag batchOption)
|
||||
( batchloop
|
||||
, seeker (starter NoBatch) params
|
||||
)
|
||||
where
|
||||
batchloop = do
|
||||
mp <- liftIO $ catchMaybeIO getLine
|
||||
case mp of
|
||||
Nothing -> return ()
|
||||
Just p -> do
|
||||
seeker (starter Batch) [p]
|
||||
batchloop
|
||||
|
||||
-- bad input is indicated by an empty line in batch mode. In non batch
|
||||
-- mode, exit on bad input.
|
||||
batchBadInput :: BatchMode -> Annex ()
|
||||
batchBadInput NoBatch = liftIO exitFailure
|
||||
batchBadInput Batch = liftIO $ putStrLn ""
|
|
@ -74,6 +74,7 @@ import qualified Command.Dead
|
|||
import qualified Command.Group
|
||||
import qualified Command.Wanted
|
||||
import qualified Command.GroupWanted
|
||||
import qualified Command.Required
|
||||
import qualified Command.Schedule
|
||||
import qualified Command.Ungroup
|
||||
import qualified Command.Vicfg
|
||||
|
@ -149,6 +150,7 @@ cmds = concat
|
|||
, Command.Group.cmd
|
||||
, Command.Wanted.cmd
|
||||
, Command.GroupWanted.cmd
|
||||
, Command.Required.cmd
|
||||
, Command.Schedule.cmd
|
||||
, Command.Ungroup.cmd
|
||||
, Command.Vicfg.cmd
|
||||
|
|
|
@ -218,8 +218,9 @@ seekHelper a params = do
|
|||
ll <- inRepo $ \g -> concat <$> forM (segmentXargsOrdered params)
|
||||
(runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g))
|
||||
forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->
|
||||
unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $
|
||||
error $ p ++ " not found"
|
||||
unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ do
|
||||
toplevelWarning False (p ++ " not found")
|
||||
Annex.incError
|
||||
return $ concat ll
|
||||
|
||||
notSymlink :: FilePath -> IO Bool
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue