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
146
147
148
149
150
151
152
153
154
|
{- git-annex command line
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module CmdLine (parseCmd) where
import System.Console.GetOpt
import Control.Monad (when)
import Control.Monad.State (liftIO)
import qualified Annex
import Types
import Command
import qualified Command.Add
import qualified Command.Unannex
import qualified Command.Drop
import qualified Command.Move
import qualified Command.Copy
import qualified Command.Get
import qualified Command.FromKey
import qualified Command.DropKey
import qualified Command.SetKey
import qualified Command.Fix
import qualified Command.Init
import qualified Command.Fsck
import qualified Command.Unused
import qualified Command.DropUnused
import qualified Command.Unlock
import qualified Command.Lock
import qualified Command.PreCommit
import qualified Command.Find
import qualified Command.Uninit
import qualified Command.Trust
import qualified Command.Untrust
subCmds :: [SubCommand]
subCmds =
[ SubCommand "add" path Command.Add.seek
"add files to annex"
, SubCommand "get" path Command.Get.seek
"make content of annexed files available"
, SubCommand "drop" path Command.Drop.seek
"indicate content of files not currently wanted"
, SubCommand "move" path Command.Move.seek
"move content of files to/from another repository"
, SubCommand "copy" path Command.Copy.seek
"copy content of files to/from another repository"
, SubCommand "unlock" path Command.Unlock.seek
"unlock files for modification"
, SubCommand "edit" path Command.Unlock.seek
"same as unlock"
, SubCommand "lock" path Command.Lock.seek
"undo unlock command"
, SubCommand "init" desc Command.Init.seek
"initialize git-annex with repository description"
, SubCommand "unannex" path Command.Unannex.seek
"undo accidential add command"
, SubCommand "uninit" path Command.Uninit.seek
"de-initialize git-annex and clean out repository"
, SubCommand "pre-commit" path Command.PreCommit.seek
"run by git pre-commit hook"
, SubCommand "trust" remote Command.Trust.seek
"trust a repository"
, SubCommand "untrust" remote Command.Untrust.seek
"do not trust a repository"
, SubCommand "fromkey" key Command.FromKey.seek
"adds a file using a specific key"
, SubCommand "dropkey" key Command.DropKey.seek
"drops annexed content for specified keys"
, SubCommand "setkey" key Command.SetKey.seek
"sets annexed content for a key using a temp file"
, SubCommand "fix" path Command.Fix.seek
"fix up symlinks to point to annexed content"
, SubCommand "fsck" maybepath Command.Fsck.seek
"check for problems"
, SubCommand "unused" nothing Command.Unused.seek
"look for unused file content"
, SubCommand "dropunused" number Command.DropUnused.seek
"drop unused file content"
, SubCommand "find" maybepath Command.Find.seek
"lists available files"
]
where
path = "PATH ..."
maybepath = "[PATH ...]"
key = "KEY ..."
desc = "DESCRIPTION"
number = "NUMBER ..."
remote = "REMOTE ..."
nothing = ""
-- Each dashed command-line option results in generation of an action
-- in the Annex monad that performs the necessary setting.
options :: [OptDescr (Annex ())]
options = [
Option ['f'] ["force"] (NoArg (storebool "force" True))
"allow actions that may lose annexed data"
, Option ['q'] ["quiet"] (NoArg (storebool "quiet" True))
"avoid verbose output"
, Option ['v'] ["verbose"] (NoArg (storebool "quiet" False))
"allow verbose output"
, Option ['b'] ["backend"] (ReqArg (storestring "backend") "NAME")
"specify default key-value backend to use"
, Option ['k'] ["key"] (ReqArg (storestring "key") "KEY")
"specify a key to use"
, Option ['t'] ["to"] (ReqArg (storestring "torepository") "REPOSITORY")
"specify to where to transfer content"
, Option ['f'] ["from"] (ReqArg (storestring "fromrepository") "REPOSITORY")
"specify from where to transfer content"
, Option ['x'] ["exclude"] (ReqArg (storestring "exclude") "GLOB")
"skip files matching the glob pattern"
]
where
storebool n b = Annex.flagChange n $ FlagBool b
storestring n s = Annex.flagChange n $ FlagString s
header :: String
header = "Usage: git-annex subcommand [option ..]"
{- Usage message with lists of options and subcommands. -}
usage :: String
usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
where
cmddescs = unlines $ map (indent . showcmd) subCmds
showcmd c =
subcmdname c ++
pad 11 (subcmdname c) ++
subcmdparams c ++
pad 13 (subcmdparams c) ++
subcmddesc c
indent l = " " ++ l
pad n s = replicate (n - length s) ' '
{- Parses command line, stores configure flags, and returns a
- list of actions to be run in the Annex monad. -}
parseCmd :: [String] -> Annex [Annex Bool]
parseCmd argv = do
(flags, params) <- liftIO $ getopt
when (null params) $ error usage
case lookupCmd (head params) of
[] -> error usage
[subcommand] -> do
_ <- sequence flags
prepSubCmd subcommand (drop 1 params)
_ -> error "internal error: multiple matching subcommands"
where
getopt = case getOpt Permute options argv of
(flags, params, []) -> return (flags, params)
(_, _, errs) -> ioError (userError (concat errs ++ usage))
lookupCmd cmd = filter (\c -> cmd == subcmdname c) subCmds
|
