Initial check-in
[darcs-mirror-ipatch.git] / Help.lhs
1 %  Copyright (C) 2002-2004 David Roundy
2 %  Copyright (C) 2010 Joachim Breitner
3 %
4 %  This program is free software; you can redistribute it and/or modify
5 %  it under the terms of the GNU General Public License as published by
6 %  the Free Software Foundation; either version 2, or (at your option)
7 %  any later version.
8 %
9 %  This program is distributed in the hope that it will be useful,
10 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
11 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 %  GNU General Public License for more details.
13 %
14 %  You should have received a copy of the GNU General Public License
15 %  along with this program; see the file COPYING.  If not, write to
16 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
17 %  Boston, MA 02110-1301, USA.
18
19 \darcsCommand{help}
20 \begin{code}
21 module Help (
22  helpCmd,
23  commandControlList, environmentHelp,          -- these are for preproc.hs
24  printVersion,
25  listAvailableCommands ) where
26
27 import Darcs.Arguments
28     ( DarcsFlag(..), environmentHelpEmail, environmentHelpSendmail )
29 import Darcs.Commands
30     ( CommandArgs(..),
31       CommandControl(..),
32       DarcsCommand(..),
33       disambiguateCommands,
34       extractCommands,
35       getCommandHelp,
36       nodefaults,
37       usageHelper )
38 import Darcs.External ( viewDoc )
39 import Darcs.Lock
40     ( environmentHelpTmpdir, environmentHelpKeepTmpdir )
41 import Darcs.Repository.Prefs
42     ( binariesFileHelp, environmentHelpHome )
43 import Darcs.Utils
44     ( withCurrentDirectory,
45       environmentHelpEditor,
46       environmentHelpPager )
47 import Data.Char ( isAlphaNum, toLower )
48 import Data.List ( groupBy )
49 import English ( andClauses )
50 import Printer ( text )
51 import Ssh
52     ( environmentHelpSsh, environmentHelpScp, environmentHelpSshPort )
53 import System.Exit ( ExitCode(..), exitWith )
54 import Version ( version )
55 import URL ( environmentHelpProxy, environmentHelpProxyPassword )
56 import Workaround ( getCurrentDirectory )
57 import qualified TheCommands as TheCommands ( commandControlList )
58
59 helpDescription :: String
60 helpDescription = "Display help about ipatch and ipatch commands."
61
62 helpHelp :: String
63 helpHelp =
64  "Without arguments, `ipatch help' prints a categorized list of ipatch\n" ++
65  "commands and a short description of each one.  With an extra argument,\n" ++
66  "`ipatch help foo' prints detailed help about the ipatch command foo.\n"
67
68 help :: DarcsCommand
69 help = DarcsCommand {commandName = "help",
70                      commandHelp = helpHelp,
71                      commandDescription = helpDescription,
72                      commandExtraArgs = -1,
73                      commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]]  "],
74                      commandCommand = \ x y -> helpCmd x y >> exitWith ExitSuccess,
75                      commandPrereq = \_ -> return $ Right (),
76                      commandGetArgPossibilities = return [],
77                      commandArgdefaults = nodefaults,
78                      commandAdvancedOptions = [],
79                      commandBasicOptions = []}
80
81 usage :: [CommandControl] -> String
82 usage cs = "Usage: ipatch COMMAND ...\n\nCommands:\n" ++
83            usageHelper cs ++ "\n" ++
84            "Use 'ipatch COMMAND --help' for help on a single command.\n" ++
85            "Use 'ipatch --version' to see the ipatch version number.\n" ++
86            "Use 'ipatch --exact-version' to get the exact version of this ipatch instance.\n"
87            -- "Use 'ipatch help environment' for help on environment variables.\n" ++
88            --"\n" ++
89            --"Check bug reports at http://bugs.darcs.net/\n"
90
91
92 helpCmd :: [DarcsFlag] -> [String] -> IO ()
93 helpCmd _ ["manpage"] = putStr $ unlines manpageLines
94 -- helpCmd _ ["environment"] = viewDoc $ text $ helpOnEnvironment
95 helpCmd _ [] = viewDoc $ text $ usage commandControlList
96
97 helpCmd _ (cmd:args) =
98     let disambiguated = disambiguateCommands commandControlList cmd args
99     in case disambiguated of
100          Left err -> fail err
101          Right (cmds,_) ->
102              let msg = case cmds of
103                          CommandOnly c       -> getCommandHelp Nothing  c
104                          SuperCommandOnly c  -> getCommandHelp Nothing  c
105                          SuperCommandSub c s -> getCommandHelp (Just c) s
106              in viewDoc $ text msg
107
108 listAvailableCommands :: IO ()
109 listAvailableCommands =
110     do here <- getCurrentDirectory
111        is_valid <- mapM
112                    (\c-> withCurrentDirectory here $ (commandPrereq c) [])
113                    (extractCommands commandControlList)
114        putStr $ unlines $ map (commandName . fst) $
115                 filter (isRight.snd) $
116                 zip (extractCommands commandControlList) is_valid
117        putStrLn "--help"
118        putStrLn "--version"
119        putStrLn "--exact-version"
120        putStrLn "--overview"
121     where isRight (Right _) = True
122           isRight _ = False
123
124 printVersion :: IO ()
125 printVersion = putStrLn $ "ipatch version " ++ version
126
127 -- avoiding a module import cycle between Help and TheCommands
128 commandControlList :: [CommandControl]
129 commandControlList =
130   CommandData help : TheCommands.commandControlList
131
132 -- FIXME: the "grouping" comments below should made subsections in the
133 -- manpage, as we already do for DarcsCommand groups. --twb, 2009
134
135 -- | Help on each environment variable in which Darcs is interested.
136 environmentHelp :: [([String], [String])]
137 environmentHelp = []
138 {-
139  -- General-purpose
140  environmentHelpHome,
141  environmentHelpEditor,
142  environmentHelpPager,
143  environmentHelpTmpdir,
144  environmentHelpKeepTmpdir,
145  environmentHelpEmail,
146  environmentHelpSendmail,
147  -- Remote Repositories
148  environmentHelpSsh,
149  environmentHelpScp,
150  environmentHelpSshPort,
151  environmentHelpProxy,
152  environmentHelpProxyPassword]
153 -}
154
155 -- | The rendered form of the data in 'environment_help'.
156 helpOnEnvironment :: String
157 helpOnEnvironment =
158     "Environment Variables\n" ++
159     "=====================\n\n" ++
160     unlines [andClauses ks ++ ":\n" ++
161                      (unlines $ map ("  " ++) ds)
162                      | (ks, ds) <- environmentHelp]
163
164 -- | This module is responsible for emitting a ipatch "man-page", a
165 -- reference document used widely on Unix-like systems.  Manpages are
166 -- primarily used as a quick reference, or "memory jogger", so the
167 -- output should be terser than the user manual.
168 --
169 -- Before modifying the output, please be sure to read the man(7) and
170 -- man-pages(7) manpages, as these respectively describe the relevant
171 -- syntax and conventions.
172
173 -- | The lines of the manpage to be printed.
174 manpageLines :: [String]
175 manpageLines = [
176  ".TH DARCS 1 \"" ++ version ++ "\"",
177  ".SH NAME",
178  "ipatch \\- an advanced revision control system",
179  ".SH SYNOPSIS",
180  ".B ipatch", ".I command", ".RI < arguments |[ options ]>...",
181  "",
182  "Where the", ".I commands", "and their respective", ".I arguments", "are",
183  "",
184  unlines synopsis,
185  ".SH DESCRIPTION",
186  -- FIXME: this is copy-and-pasted from ipatch.cabal, so
187  -- it'll get out of date as people forget to maintain
188  -- both in sync.
189  "ipatch is a free, open source revision control",
190  "system. It is:",
191  ".TP 3", "\\(bu",
192  "Distributed: Every user has access to the full",
193  "command set, removing boundaries between server and",
194  "client or committer and non\\(hycommitters.",
195  ".TP", "\\(bu",
196  "Interactive: ipatch is easy to learn and efficient to",
197  "use because it asks you questions in response to",
198  "simple commands, giving you choices in your work",
199  "flow. You can choose to record one change in a file,",
200  "while ignoring another. As you update from upstream,",
201  "you can review each patch name, even the full `diff'",
202  "for interesting patches.",
203  ".TP", "\\(bu",
204  "Smart: ipatch is based on a unique algebra of patches, ",
205  "Originally developed by physicist David Roundy",
206  ".SH OPTIONS",
207  "Different options are accepted by different ipatch commands.",
208  "Each command's most important options are listed in the",
209  ".B COMMANDS",
210  "section.  For a full list of all options accepted by",
211  "a particular command, run `ipatch", ".I command", "\\-\\-help'.",
212  ".SH COMMANDS",
213  unlines commands,
214  unlines environment,
215  {-
216  ".SH BUGS",
217  "At http://bugs.darcs.net/ you can find a list of known",
218  "bugs in ipatch.  Unknown bugs can be reported at that",
219  "site (after creating an account) or by emailing the",
220  "report to bugs@darcs.net.",
221  -}
222  -- ".SH EXAMPLE",
223  -- FIXME:
224  -- new project: init, rec -la;
225  -- track upstream project: get, pull -a;
226  -- contribute to project: add, rec, push/send.
227  ".SH SEE ALSO"
228  {-"A user manual is included with ipatch, in PDF and HTML",
229  "form.  It can also be found at http://darcs.net/manual/."
230  -}
231  ]
232     where
233       -- | A synopsis line for each command.  Uses 'foldl' because it is
234       -- necessary to avoid blank lines from Hidden_commands, as groff
235       -- translates them into annoying vertical padding (unlike TeX).
236       synopsis :: [String]
237       synopsis = foldl iter [] commandControlList
238           where iter :: [String] -> CommandControl -> [String]
239                 iter acc (GroupName _) = acc
240                 iter acc (HiddenCommand _) = acc
241                 iter acc (CommandData c@SuperCommand {}) =
242                     acc ++ concatMap
243                             (render (commandName c ++ " "))
244                             (extractCommands (commandSubCommands c))
245                 iter acc (CommandData c) = acc ++ render "" c
246                 render :: String -> DarcsCommand -> [String]
247                 render prefix c =
248                     [".B ipatch " ++ prefix ++ commandName c] ++
249                     (map mangle_args $ commandExtraArgHelp c) ++
250                     -- In the output, we want each command to be on its own
251                     -- line, but we don't want blank lines between them.
252                     -- AFAICT this can only be achieved with the .br
253                     -- directive, which is probably a GNUism.
254                     [".br"]
255
256       -- | As 'synopsis', but make each group a subsection (.SS), and
257       -- include the help text for each command.
258       commands :: [String]
259       commands = foldl iter [] commandControlList
260           where iter :: [String] -> CommandControl -> [String]
261                 iter acc (GroupName x) = acc ++ [".SS \"" ++ x ++ "\""]
262                 iter acc (HiddenCommand _) = acc
263                 iter acc (CommandData c@SuperCommand {}) =
264                     acc ++ concatMap
265                             (render (commandName c ++ " "))
266                             (extractCommands (commandSubCommands c))
267                 iter acc (CommandData c) = acc ++ render "" c
268                 render :: String -> DarcsCommand -> [String]
269                 render prefix c =
270                     [".B ipatch " ++ prefix ++ commandName c] ++
271                     (map mangle_args $ commandExtraArgHelp c) ++
272                     [".RS 4", escape $ commandHelp c, ".RE"]
273
274       -- | Now I'm showing off: mangle the extra arguments of Darcs commands
275       -- so as to use the ideal format for manpages, italic words and roman
276       -- punctuation.
277       mangle_args :: String -> String
278       mangle_args s =
279           ".RI " ++ (unwords $ map show (groupBy cmp $ map toLower $ gank s))
280               where cmp x y = not $ xor (isAlphaNum x) (isAlphaNum y)
281                     xor x y = (x && not y) || (y && not x)
282                     gank (' ':'o':'r':' ':xs) = '|' : gank xs
283                     gank (x:xs) = x : gank xs
284                     gank [] = []
285
286       environment :: [String]
287       environment = ".SH ENVIRONMENT" : concat
288                     [(".SS \"" ++ andClauses ks ++ "\"") : map escape ds
289                      | (ks, ds) <- environmentHelp]
290
291       -- | Copied from Preproc.escape_latex_specials.
292       escape :: String -> String
293       escape = minus . bs       -- Order is important
294         where
295           minus      = replace "-"     "\\-"
296           bs         = replace "\\"    "\\\\"
297
298           replace :: Eq a => [a] -> [a] -> [a] -> [a]
299           replace _ _ [] = []
300           replace find repl s =
301               if take (length find) s == find
302                   then repl ++ (replace find repl (drop (length find) s))
303                   else [head s] ++ replace find repl (tail s)
304
305 \end{code}