started converting to use optparse-applicative

This is a work in progress. It compiles and is able to do basic command
dispatch, including git autocorrection, while using optparse-applicative
for the core commandline parsing.

* Many commands are temporarily disabled before conversion.
* Options are not wired in yet.
* cmdnorepo actions don't work yet.

Also, removed the [Command] list, which was only used in one place.
This commit is contained in:
Joey Hess 2015-07-08 12:33:27 -04:00
parent 4018e5f6f1
commit a2ba701056
104 changed files with 435 additions and 370 deletions

View file

@ -1,6 +1,6 @@
{- git-annex command line parsing and dispatch
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -16,7 +16,7 @@ module CmdLine (
import qualified Control.Exception as E
import qualified Data.Map as M
import Control.Exception (throw)
import System.Console.GetOpt
import qualified Options.Applicative as O
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif
@ -35,6 +35,41 @@ import Types.Messages
dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
setupConsole
go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
where
go (Right g) = do
state <- Annex.new g
Annex.eval state $ do
checkEnvironment
when fuzzy $
inRepo $ autocorrect . Just
forM_ fields $ uncurry Annex.setField
(cmd, seek) <- liftIO $
O.handleParseResult (parseCmd (name:args) allcmds)
when (cmdnomessages cmd) $
Annex.setOutput QuietOutput
-- TODO: propigate global options to annex state (how?)
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
startup
performCommandAction cmd seek $
shutdown $ cmdnocommit cmd
go (Left e) = do
when fuzzy $
autocorrect =<< Git.Config.global
-- a <- O.handleParseResult (parseCmd (name:args) allcmds)
error "TODO"
autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds
err msg = msg ++ "\n\n" ++ usage header allcmds
(fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds err
name
| fuzzy = case cmds of
[c] -> cmdname c
_ -> inputcmdname
| otherwise = inputcmdname
#if 0
case getOptCmd args cmd commonoptions of
Right (flags, params) -> go flags params
=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
@ -59,10 +94,19 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
when fuzzy $
autocorrect =<< Git.Config.global
maybe (throw e) (\a -> a params) (cmdnorepo cmd)
err msg = msg ++ "\n\n" ++ usage header allcmds
cmd = Prelude.head cmds
(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
autocorrect = Git.AutoCorrect.prepare name cmdname cmds
#endif
{- Parses command line and selects a command to run and gets the
- seek action for the command. -}
parseCmd :: CmdParams -> [Command] -> O.ParserResult (Command, CommandSeek)
parseCmd allargs allcmds = O.execParserPure (O.prefs O.idm) pinfo allargs
where
pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds) O.idm
mkcommand c = O.command (cmdname c) (O.info (mkparser c) O.idm)
mkparser c = (,)
<$> pure c
<*> cmdparser c
{- Parses command line params far enough to find the Command to run, and
- returns the remaining params.
@ -84,18 +128,6 @@ findCmd fuzzyok argv cmds err
Nothing -> []
Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
{- Parses command line options, and returns actions to run to configure flags
- and the remaining parameters for the command. -}
getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams)
getOptCmd argv cmd commonoptions = check $
getOpt Permute (commonoptions ++ cmdoptions cmd) argv
where
check (flags, rest, []) = Right (flags, rest)
check (_, _, errs) = Left $ unlines
[ concat errs
, commandUsage cmd
]
{- Actions to perform each time ran. -}
startup :: Annex ()
startup =