cooler command-line handling
This commit is contained in:
parent
90cdc61c7c
commit
a0c0136056
2 changed files with 24 additions and 38 deletions
44
Commands.hs
44
Commands.hs
|
@ -1,9 +1,7 @@
|
|||
{- git-annex command line -}
|
||||
|
||||
module Commands (
|
||||
argvToMode,
|
||||
dispatch,
|
||||
Mode
|
||||
argvToActions
|
||||
) where
|
||||
|
||||
import System.Console.GetOpt
|
||||
|
@ -23,43 +21,31 @@ import LocationLog
|
|||
import Types
|
||||
import Core
|
||||
|
||||
data Mode = Default | Add | Push | Pull | Want | Get | Drop | Unannex
|
||||
deriving Show
|
||||
|
||||
options :: [OptDescr Mode]
|
||||
options :: [OptDescr (String -> Annex ())]
|
||||
options =
|
||||
[ Option ['a'] ["add"] (NoArg Add) "add files to annex"
|
||||
, Option ['p'] ["push"] (NoArg Push) "push annex to repos"
|
||||
, Option ['P'] ["pull"] (NoArg Pull) "pull annex from repos"
|
||||
, Option ['w'] ["want"] (NoArg Want) "request file contents"
|
||||
, Option ['g'] ["get"] (NoArg Get) "transfer file contents"
|
||||
, Option ['d'] ["drop"] (NoArg Drop) "indicate file contents not needed"
|
||||
, Option ['u'] ["unannex"] (NoArg Unannex) "undo --add"
|
||||
[ Option ['a'] ["add"] (NoArg addCmd) "add files to annex"
|
||||
, Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos"
|
||||
, Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos"
|
||||
, Option ['w'] ["want"] (NoArg wantCmd) "request file contents"
|
||||
, Option ['g'] ["get"] (NoArg getCmd) "transfer file contents"
|
||||
, Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed"
|
||||
, Option ['u'] ["unannex"] (NoArg unannexCmd) "undo --add"
|
||||
]
|
||||
|
||||
argvToMode argv = do
|
||||
{- Parses command line and returns a list of actons to be run in the Annex
|
||||
- monad. -}
|
||||
argvToActions :: [String] -> IO [Annex ()]
|
||||
argvToActions argv = do
|
||||
case getOpt Permute options argv of
|
||||
([],files,[]) -> return (Default, files)
|
||||
([],files,[]) -> return $ map defaultCmd files
|
||||
-- one mode is normal case
|
||||
(m:[],files,[]) -> return (m, files)
|
||||
(m:[],files,[]) -> return $ map m files
|
||||
-- multiple modes is an error
|
||||
(ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options))
|
||||
-- error case
|
||||
(_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options))
|
||||
where header = "Usage: git-annex [mode] file"
|
||||
|
||||
dispatch :: Mode -> FilePath -> Annex ()
|
||||
dispatch mode item = do
|
||||
case (mode) of
|
||||
Default -> defaultCmd item
|
||||
Add -> addCmd item
|
||||
Push -> pushCmd item
|
||||
Pull -> pullCmd item
|
||||
Want -> wantCmd item
|
||||
Get -> getCmd item
|
||||
Drop -> dropCmd item
|
||||
Unannex -> unannexCmd item
|
||||
|
||||
{- Default mode is to annex a file if it is not already, and otherwise
|
||||
- get its content. -}
|
||||
defaultCmd :: FilePath -> Annex ()
|
||||
|
|
18
git-annex.hs
18
git-annex.hs
|
@ -10,9 +10,9 @@ import Commands
|
|||
|
||||
main = do
|
||||
args <- getArgs
|
||||
(mode, params) <- argvToMode args
|
||||
actions <- argvToActions args
|
||||
state <- start
|
||||
tryRun state mode params
|
||||
tryRun state actions
|
||||
|
||||
{- Processes each param in the list by dispatching the handler function
|
||||
- for the user-selection operation mode. Catches exceptions, not stopping
|
||||
|
@ -23,17 +23,17 @@ main = do
|
|||
- or more likely I missed an easy way to do it. So, I have to laboriously
|
||||
- thread AnnexState through this function.
|
||||
-}
|
||||
tryRun :: AnnexState -> Mode -> [String] -> IO ()
|
||||
tryRun state mode params = tryRun' state mode 0 0 params
|
||||
tryRun' state mode errnum oknum (f:fs) = do
|
||||
tryRun :: AnnexState -> [Annex ()] -> IO ()
|
||||
tryRun state actions = tryRun' state 0 0 actions
|
||||
tryRun' state errnum oknum (a:as) = do
|
||||
result <- try
|
||||
(Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState))
|
||||
(Annex.run state a)::IO (Either SomeException ((), AnnexState))
|
||||
case (result) of
|
||||
Left err -> do
|
||||
showErr err
|
||||
tryRun' state mode (errnum + 1) oknum fs
|
||||
Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs
|
||||
tryRun' state mode errnum oknum [] = do
|
||||
tryRun' state (errnum + 1) oknum as
|
||||
Right (_,state') -> tryRun' state' errnum (oknum + 1) as
|
||||
tryRun' state errnum oknum [] = do
|
||||
if (errnum > 0)
|
||||
then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok"
|
||||
else return ()
|
||||
|
|
Loading…
Reference in a new issue