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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{- git-annex command line parsing and dispatch
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module CmdLine (
dispatch,
usage,
shutdown
) where
import qualified Control.Exception as E
import qualified Data.Map as M
import Control.Exception (throw)
import qualified Options.Applicative as O
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif
import Common.Annex
import qualified Annex
import qualified Git
import qualified Git.AutoCorrect
import qualified Git.Config
import Annex.Content
import Annex.Environment
import Command
import Types.Messages
{- Runs the passed command line. -}
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))
Left parseerr -> error parseerr
where
go flags params (Right g) = do
state <- Annex.new g
Annex.eval state $ do
checkEnvironment
when fuzzy $
inRepo $ autocorrect . Just
forM_ fields $ uncurry Annex.setField
when (cmdnomessages cmd) $
Annex.setOutput QuietOutput
sequence_ flags
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
startup
performCommandAction cmd params $
shutdown $ cmdnocommit cmd
go _flags params (Left e) = do
when fuzzy $
autocorrect =<< Git.Config.global
maybe (throw e) (\a -> a params) (cmdnorepo cmd)
cmd = Prelude.head 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.
- Does fuzzy matching if necessary, which may result in multiple Commands. -}
findCmd :: Bool -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams)
findCmd fuzzyok argv cmds err
| isNothing name = error $ err "missing command"
| not (null exactcmds) = (False, exactcmds, fromJust name, args)
| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)
| otherwise = error $ err $ "unknown command " ++ fromJust name
where
(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
{- Actions to perform each time ran. -}
startup :: Annex ()
startup =
#ifndef mingw32_HOST_OS
liftIO $ void $ installHandler sigINT Default Nothing
#else
return ()
#endif
{- Cleanup actions. -}
shutdown :: Bool -> Annex ()
shutdown nocommit = do
saveState nocommit
sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
liftIO reapZombies -- zombies from long-running git processes
|
