diff options
Diffstat (limited to 'CmdLine')
| -rw-r--r-- | CmdLine/Action.hs | 9 | ||||
| -rw-r--r-- | CmdLine/Batch.hs | 41 | ||||
| -rw-r--r-- | CmdLine/GitAnnex.hs | 2 | ||||
| -rw-r--r-- | CmdLine/Seek.hs | 5 |
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 |