1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{- git-annex command line parsing and dispatch
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module CmdLine (
dispatch,
usage,
parseCmd,
prepRunCommand,
) where
import qualified Options.Applicative as O
import qualified Options.Applicative.Help as H
import qualified Control.Exception as E
import Control.Exception (throw)
import Annex.Common
import qualified Annex
import qualified Git
import qualified Git.AutoCorrect
import qualified Git.Config
import Annex.Action
import Annex.Environment
import Command
import Types.Messages
{- Runs the passed command line. -}
dispatch :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = 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
forM_ fields $ uncurry Annex.setField
(cmd, seek, globalconfig) <- parsewith False cmdparser
(\a -> inRepo $ a . Just)
(liftIO . O.handleParseResult)
prepRunCommand cmd globalconfig
startup
performCommandAction cmd seek $
shutdown $ cmdnocommit cmd
go (Left norepo) = do
let ingitrepo = \a -> a =<< Git.Config.global
-- Parse command line with full cmdparser first,
-- so that help can be displayed for bad parses
-- even when not run in a repo.
res <- parsewith False cmdparser ingitrepo return
case res of
Failure _ -> void (O.handleParseResult res)
_ -> do
-- Parse command line in norepo mode.
(_, a, _globalconfig) <- parsewith True
(fromMaybe (throw norepo) . cmdnorepo)
ingitrepo
O.handleParseResult
a
parsewith secondrun getparser ingitrepo handleresult =
case parseCmd progname progdesc globaloptions allargs allcmds getparser of
O.Failure _ -> do
-- parse failed, so fall back to
-- fuzzy matching, or to showing usage
when (fuzzy && not secondrun) $
ingitrepo autocorrect
handleresult (parseCmd progname progdesc globaloptions correctedargs allcmds getparser)
res -> handleresult res
where
autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds
(fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds
name
| fuzzy = case cmds of
(c:_) -> Just (cmdname c)
_ -> inputcmdname
| otherwise = inputcmdname
correctedargs = case name of
Nothing -> allargs
Just n -> n:args
{- Parses command line, selecting one of the commands from the list. -}
parseCmd :: String -> String -> [GlobalOption] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter)
parseCmd progname progdesc globaloptions allargs allcmds getparser =
O.execParserPure (O.prefs O.idm) pinfo allargs
where
pinfo = O.info (O.helper <*> subcmds) (O.progDescDoc (Just intro))
subcmds = O.hsubparser $ mconcat $ map mkcommand allcmds
mkcommand c = O.command (cmdname c) $ O.info (mkparser c) $ O.fullDesc
<> O.header (synopsis (progname ++ " " ++ cmdname c) (cmddesc c))
<> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c)
mkparser c = (,,)
<$> pure c
<*> getparser c
<*> combineGlobalOptions (globaloptions ++ cmdglobaloptions c)
synopsis n d = n ++ " - " ++ d
intro = mconcat $ concatMap (\l -> [H.text l, H.line])
(synopsis progname progdesc : commandList allcmds)
{- Parses command line params far enough to find the Command to run, and
- returns the remaining params.
- Does fuzzy matching if necessary, which may result in multiple Commands. -}
findCmd :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams)
findCmd fuzzyok argv cmds
| not (null exactcmds) = ret (False, exactcmds)
| fuzzyok && not (null inexactcmds) = ret (True, inexactcmds)
| otherwise = ret (False, [])
where
ret (fuzzy, matches) = (fuzzy, matches, name, args)
(name, args) = findname argv []
findname [] c = (Nothing, reverse c)
findname (a:as) c
| "-" `isPrefixOf` a = findname as (a:c)
| otherwise = (Just a, reverse c ++ as)
exactcmds = filter (\c -> name == Just (cmdname c)) cmds
inexactcmds = case name of
Nothing -> []
Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
prepRunCommand :: Command -> GlobalSetter -> Annex ()
prepRunCommand cmd globalconfig = do
when (cmdnomessages cmd) $ do
Annex.setOutput QuietOutput
Annex.changeState $ \s -> s
{ Annex.output = (Annex.output s) { implicitMessages = False } }
getParsed globalconfig
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
|
