factor out a little more
This commit is contained in:
parent
1c451fe362
commit
88ff9e82fc
3 changed files with 18 additions and 17 deletions
15
CmdLine.hs
15
CmdLine.hs
|
@ -6,19 +6,25 @@
|
|||
-}
|
||||
|
||||
module CmdLine (
|
||||
cmdLine,
|
||||
parseCmd,
|
||||
Option,
|
||||
storeOptBool,
|
||||
storeOptString,
|
||||
) where
|
||||
|
||||
import System.Environment
|
||||
import System.Console.GetOpt
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.State (liftIO)
|
||||
|
||||
import qualified Annex
|
||||
import qualified GitRepo as Git
|
||||
import Types
|
||||
import Command
|
||||
import BackendList
|
||||
import Core
|
||||
import Upgrade
|
||||
|
||||
{- Each dashed command-line option results in generation of an action
|
||||
- in the Annex monad that performs the necessary setting.
|
||||
|
@ -30,6 +36,15 @@ storeOptBool name val = Annex.flagChange name $ FlagBool val
|
|||
storeOptString :: FlagName -> String -> Annex ()
|
||||
storeOptString name val = Annex.flagChange name $ FlagString val
|
||||
|
||||
{- It all starts here. -}
|
||||
cmdLine :: [Command] -> [Option] -> String -> IO ()
|
||||
cmdLine cmds options header = do
|
||||
args <- getArgs
|
||||
gitrepo <- Git.repoFromCwd
|
||||
state <- Annex.new gitrepo allBackends
|
||||
(actions, state') <- Annex.run state $ parseCmd args header cmds options
|
||||
tryRun state' $ [startup, upgrade] ++ actions
|
||||
|
||||
{- Parses command line, stores configure flags, and returns a
|
||||
- list of actions to be run in the Annex monad. -}
|
||||
parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool]
|
||||
|
|
2
Core.hs
2
Core.hs
|
@ -45,7 +45,7 @@ tryRun' state errnum (a:as) = do
|
|||
tryRun' state errnum [] = do
|
||||
_ <- try $ Annex.run state $ shutdown errnum
|
||||
when (errnum > 0) $ error $ show errnum ++ " failed"
|
||||
|
||||
|
||||
{- Actions to perform each time ran. -}
|
||||
startup :: Annex Bool
|
||||
startup = do
|
||||
|
|
18
git-annex.hs
18
git-annex.hs
|
@ -5,17 +5,11 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
import System.Environment
|
||||
import System.Console.GetOpt
|
||||
|
||||
import qualified Annex
|
||||
import Core
|
||||
import Upgrade
|
||||
import CmdLine
|
||||
import qualified GitRepo as Git
|
||||
import BackendList
|
||||
|
||||
import Command
|
||||
|
||||
import qualified Command.Add
|
||||
import qualified Command.Unannex
|
||||
import qualified Command.Drop
|
||||
|
@ -83,13 +77,5 @@ options = [
|
|||
"skip files matching the glob pattern"
|
||||
]
|
||||
|
||||
header :: String
|
||||
header = "Usage: git-annex subcommand [option ..]"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
gitrepo <- Git.repoFromCwd
|
||||
state <- Annex.new gitrepo allBackends
|
||||
(actions, state') <- Annex.run state $ parseCmd args header cmds options
|
||||
tryRun state' $ [startup, upgrade] ++ actions
|
||||
main = cmdLine cmds options "Usage: git-annex subcommand [option ..]"
|
||||
|
|
Loading…
Add table
Reference in a new issue