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