Skip to content
Snippets Groups Projects
CmdLine.hs 2.07 KiB
Newer Older
{- git-annex command line parsing
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

Joey Hess's avatar
Joey Hess committed
	dispatch,

import System.Console.GetOpt
Joey Hess's avatar
Joey Hess committed
import Control.Monad (when)
import Control.Monad.State (liftIO)

import qualified Annex
Joey Hess's avatar
Joey Hess committed
import qualified GitRepo as Git
import Types
import Command
Joey Hess's avatar
Joey Hess committed
import BackendList
import Core
import Upgrade
Joey Hess's avatar
Joey Hess committed
import Options
Joey Hess's avatar
Joey Hess committed
{- Runs the passed command line. -}
dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO ()
dispatch gitrepo args cmds options header = do
Joey Hess's avatar
Joey Hess committed
	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]
parseCmd argv header cmds options = do
	(flags, params) <- liftIO $ getopt
Joey Hess's avatar
Joey Hess committed
	when (null params) $ error $ "missing command" ++ usagemsg
Joey Hess's avatar
Joey Hess committed
	case lookupCmd (head params) of
Joey Hess's avatar
Joey Hess committed
		[] -> error $ "unknown command" ++ usagemsg
			_ <- sequence flags
			prepCmd command (drop 1 params)
		_ -> error "internal error: multiple matching commands"
	where
		getopt = case getOpt Permute options argv of
Joey Hess's avatar
Joey Hess committed
			(flags, params, []) ->
				return (flags, params)
			(_, _, errs) ->
				ioError (userError (concat errs ++ usagemsg))
		lookupCmd cmd = filter (\c -> cmd  == cmdname c) cmds
Joey Hess's avatar
Joey Hess committed
		usagemsg = "\n\n" ++ usage header cmds options

{- Usage message with lists of commands and options. -}
usage :: String -> [Command] -> [Option] -> String
usage header cmds options =
Joey Hess's avatar
Joey Hess committed
	usageInfo (header ++ "\n\nOptions:") options ++
		"\nCommands:\n" ++ cmddescs
	where
		cmddescs = unlines $ map (indent . showcmd) cmds
		showcmd c =
			cmdname c ++
Joey Hess's avatar
Joey Hess committed
			pad (longest cmdname + 1) (cmdname c) ++
Joey Hess's avatar
Joey Hess committed
			pad (longest cmdparams + 2) (cmdparams c) ++
			cmddesc c
		indent l = "  " ++ l
		pad n s = replicate (n - length s) ' '
Joey Hess's avatar
Joey Hess committed
		longest f = foldl max 0 $ map (length . f) cmds