summaryrefslogtreecommitdiff
path: root/CmdLine
diff options
context:
space:
mode:
Diffstat (limited to 'CmdLine')
-rw-r--r--CmdLine/Action.hs9
-rw-r--r--CmdLine/Batch.hs41
-rw-r--r--CmdLine/GitAnnex.hs2
-rw-r--r--CmdLine/Seek.hs5
4 files changed, 48 insertions, 9 deletions
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 5bef833c2..2838e4ff8 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -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
diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs
new file mode 100644
index 000000000..836472eb0
--- /dev/null
+++ b/CmdLine/Batch.hs
@@ -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 ""
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index fde4e2d08..326dd3b2b 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -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
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index ea06fc976..3166ab83d 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -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