--  Copyright (C) 2002-2004 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

module Darcs.UI.Commands.Help (
 helpCmd,
 commandControlList, environmentHelp,          -- these are for preproc.hs
 printVersion,
 listAvailableCommands ) where

import Prelude ()
import Darcs.Prelude

import Darcs.UI.Flags
    ( DarcsFlag
    , environmentHelpEmail
    , environmentHelpSendmail
    )
import Darcs.UI.Options.Markdown ( optionsMarkdown )
import Darcs.UI.Commands
    ( CommandArgs(..)
    , CommandControl(..)
    , normalCommand
    , DarcsCommand(..)
    , WrappedCommand(..)
    , wrappedCommandName
    , disambiguateCommands
    , extractCommands
    , getSubcommands
    , nodefaults
    )
import Darcs.UI.External ( viewDoc )
import Darcs.UI.Usage
    ( getCommandHelp
    , usage
    , subusage
    )
import Darcs.Util.Lock ( environmentHelpTmpdir, environmentHelpKeepTmpdir
                       , environmentHelpLocks )
import Darcs.Patch.Match ( helpOnMatchers )
import Darcs.Repository.Prefs ( environmentHelpHome, prefsFilesHelp )
import Darcs.Util.Ssh ( environmentHelpSsh, environmentHelpScp, environmentHelpSshPort )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Path ( AbsolutePath )
import Control.Arrow ( (***) )
import Data.Char ( isAlphaNum, toLower, toUpper )
import Data.Either ( partitionEithers )
import Data.List ( groupBy, isPrefixOf, intercalate, nub, lookup )
import Darcs.Util.English ( andClauses )
import Darcs.Util.Printer (text, vcat, vsep, ($$), empty)
import Darcs.Util.Printer.Color ( environmentHelpColor, environmentHelpEscape, environmentHelpEscapeWhite )
import System.Exit ( exitSuccess )
import Version ( version )
import Darcs.Util.Download ( environmentHelpProxy, environmentHelpProxyPassword )
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.UI.Options ( defaultFlags, ocheck, onormalise, oid )
import qualified Darcs.UI.TheCommands as TheCommands

helpDescription :: String
helpDescription :: String
helpDescription = "Display help about darcs and darcs commands."

helpHelp :: String
helpHelp :: String
helpHelp =
 "Without arguments, `darcs help` prints a categorized list of darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "commands and a short description of each one.  With an extra argument,\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "`darcs help foo` prints detailed help about the darcs command foo.\n"

-- | Starting from a list of 'CommandControl's, unwrap one level
-- to get a list of command names together with their subcommands.
unwrapTree :: [CommandControl] -> [(String, [CommandControl])]
unwrapTree :: [CommandControl] -> [(String, [CommandControl])]
unwrapTree cs :: [CommandControl]
cs = [ (WrappedCommand -> String
wrappedCommandName WrappedCommand
c, WrappedCommand -> [CommandControl]
subcmds WrappedCommand
c) | CommandData c :: WrappedCommand
c <- [CommandControl]
cs ]
  where
    subcmds :: WrappedCommand -> [CommandControl]
subcmds (WrappedCommand sc :: DarcsCommand parsedFlags
sc) = DarcsCommand parsedFlags -> [CommandControl]
forall pf. DarcsCommand pf -> [CommandControl]
getSubcommands DarcsCommand parsedFlags
sc

-- | Given a list of (normal) arguments to the help command, produce a list
-- of possible completions for the next (normal) argument.
completeArgs :: [String] -> [String]
completeArgs :: [String] -> [String]
completeArgs [] = ((String, [CommandControl]) -> String)
-> [(String, [CommandControl])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [CommandControl]) -> String
forall a b. (a, b) -> a
fst ([CommandControl] -> [(String, [CommandControl])]
unwrapTree [CommandControl]
commandControlList) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs where
  extraArgs :: [String]
extraArgs = [ "manpage", "markdown", "patterns", "environment" ]
completeArgs (arg :: String
arg:args :: [String]
args) = String -> [String] -> [CommandControl] -> [String]
exploreTree String
arg [String]
args [CommandControl]
commandControlList where
  exploreTree :: String -> [String] -> [CommandControl] -> [String]
exploreTree cmd :: String
cmd cmds :: [String]
cmds cs :: [CommandControl]
cs =
    case String -> [(String, [CommandControl])] -> Maybe [CommandControl]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd ([CommandControl] -> [(String, [CommandControl])]
unwrapTree [CommandControl]
cs) of
      Nothing -> []
      Just cs' :: [CommandControl]
cs' -> case [String]
cmds of
        [] -> ((String, [CommandControl]) -> String)
-> [(String, [CommandControl])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [CommandControl]) -> String
forall a b. (a, b) -> a
fst ([CommandControl] -> [(String, [CommandControl])]
unwrapTree [CommandControl]
cs')
        sub :: String
sub:cmds' :: [String]
cmds' -> String -> [String] -> [CommandControl] -> [String]
exploreTree String
sub [String]
cmds' [CommandControl]
cs'

help :: DarcsCommand [DarcsFlag]
help :: DarcsCommand [DarcsFlag]
help = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
    { commandProgramName :: String
commandProgramName = "darcs"
    , commandName :: String
commandName = "help"
    , commandHelp :: String
commandHelp = String
helpHelp
    , commandDescription :: String
commandDescription = String
helpDescription
    , commandExtraArgs :: Int
commandExtraArgs = -1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]]  "]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = \ x :: (AbsolutePath, AbsolutePath)
x y :: [DarcsFlag]
y z :: [String]
z -> (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
helpCmd (AbsolutePath, AbsolutePath)
x [DarcsFlag]
y [String]
z IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = \_ -> Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = \_ _ -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
completeArgs
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = []
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = []
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec Any DarcsFlag [DarcsFlag] [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec Any DarcsFlag [DarcsFlag] [DarcsFlag]
forall (d :: * -> *) f a. OptSpec d f a a
oid
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec Any DarcsFlag Any Any -> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec Any DarcsFlag Any Any
forall (d :: * -> *) f a. OptSpec d f a a
oid
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec Any DarcsFlag [DarcsFlag] [DarcsFlag]
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec Any DarcsFlag [DarcsFlag] [DarcsFlag]
forall (d :: * -> *) f a. OptSpec d f a a
oid
    }

helpCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
helpCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
helpCmd _ _ ["manpage"] = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
manpageLines
helpCmd _ _ ["markdown"] = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
markdownLines
helpCmd _ _ ["patterns"] = Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
helpOnMatchers
helpCmd _ _ ("environment":vs_ :: [String]
vs_) =
    Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc
header Doc -> Doc -> Doc
$$
              [Doc] -> Doc
vsep ((([String], [String]) -> Doc) -> [([String], [String])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([String], [String]) -> Doc
render [([String], [String])]
known) Doc -> Doc -> Doc
$$
              Doc
footer
  where
    header :: Doc
header | [([String], [String])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], [String])]
known = Doc
empty
           | Bool
otherwise = String -> Doc
text "Environment Variables" Doc -> Doc -> Doc
$$
                         String -> Doc
text "====================="

    footer :: Doc
footer | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unknown = Doc
empty
           | Bool
otherwise = String -> Doc
text "" Doc -> Doc -> Doc
$$
                         String -> Doc
text ("Unknown environment variables: "
                               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
unknown)

    render :: ([String], [String]) -> Doc
render (ks :: [String]
ks, ds :: [String]
ds) = String -> Doc
text ([String] -> String
andClauses [String]
ks String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":") Doc -> Doc -> Doc
$$
                      [Doc] -> Doc
vcat [ String -> Doc
text ("  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d) | String
d <- [String]
ds ]

    (unknown :: [String]
unknown, known :: [([String], [String])]
known) = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) [String]
vs_ of
                           [] -> ([], [([String], [String])]
environmentHelp)
                           vs :: [String]
vs -> ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([[([String], [String])]] -> [([String], [String])])
-> ([String], [[([String], [String])]])
-> ([String], [([String], [String])])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ([([String], [String])] -> [([String], [String])]
forall a. Eq a => [a] -> [a]
nub ([([String], [String])] -> [([String], [String])])
-> ([[([String], [String])]] -> [([String], [String])])
-> [[([String], [String])]]
-> [([String], [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([String], [String])]] -> [([String], [String])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)) (([String], [[([String], [String])]])
 -> ([String], [([String], [String])]))
-> ([Either String [([String], [String])]]
    -> ([String], [[([String], [String])]]))
-> [Either String [([String], [String])]]
-> ([String], [([String], [String])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [([String], [String])]]
-> ([String], [[([String], [String])]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String [([String], [String])]]
 -> ([String], [([String], [String])]))
-> [Either String [([String], [String])]]
-> ([String], [([String], [String])])
forall a b. (a -> b) -> a -> b
$
                                     (String -> Either String [([String], [String])])
-> [String] -> [Either String [([String], [String])]]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String [([String], [String])]
doLookup [String]
vs

    -- v is not known if it doesn't appear in the list of aliases of any
    -- of the environment var help descriptions.
    doLookup :: String -> Either String [([String], [String])]
doLookup v :: String
v = case (([String], [String]) -> Bool)
-> [([String], [String])] -> [([String], [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([String] -> Bool)
-> (([String], [String]) -> [String])
-> ([String], [String])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst) [([String], [String])]
environmentHelp of
                     [] -> String -> Either String [([String], [String])]
forall a b. a -> Either a b
Left String
v
                     es :: [([String], [String])]
es -> [([String], [String])] -> Either String [([String], [String])]
forall a b. b -> Either a b
Right [([String], [String])]
es

helpCmd _ _ [] = Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [CommandControl] -> Doc
usage [CommandControl]
commandControlList

helpCmd _ _ (cmd :: String
cmd:args :: [String]
args) =
    case [CommandControl]
-> String -> [String] -> Either String (CommandArgs, [String])
disambiguateCommands [CommandControl]
commandControlList String
cmd [String]
args of
         Left err :: String
err -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
         Right (cmds :: CommandArgs
cmds,as :: [String]
as) ->
             let msg :: Doc
msg = case CommandArgs
cmds of
                         CommandOnly c :: DarcsCommand parsedFlags
c       -> Maybe (DarcsCommand Any) -> DarcsCommand parsedFlags -> Doc
forall pf1 pf2. Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
getCommandHelp Maybe (DarcsCommand Any)
forall a. Maybe a
Nothing  DarcsCommand parsedFlags
c
                         SuperCommandOnly c :: DarcsCommand parsedFlags
c  ->
                          if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
as then
                            Maybe (DarcsCommand Any) -> DarcsCommand parsedFlags -> Doc
forall pf1 pf2. Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
getCommandHelp Maybe (DarcsCommand Any)
forall a. Maybe a
Nothing  DarcsCommand parsedFlags
c
                          else
                            String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "Invalid subcommand!\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
subusage DarcsCommand parsedFlags
c
                         SuperCommandSub c :: DarcsCommand parsedFlags1
c s :: DarcsCommand parsedFlags2
s -> Maybe (DarcsCommand parsedFlags1)
-> DarcsCommand parsedFlags2 -> Doc
forall pf1 pf2. Maybe (DarcsCommand pf1) -> DarcsCommand pf2 -> Doc
getCommandHelp (DarcsCommand parsedFlags1 -> Maybe (DarcsCommand parsedFlags1)
forall a. a -> Maybe a
Just DarcsCommand parsedFlags1
c) DarcsCommand parsedFlags2
s
             in Doc -> IO ()
viewDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc
msg

listAvailableCommands :: IO ()
listAvailableCommands :: IO ()
listAvailableCommands =
    do String
here <- IO String
getCurrentDirectory
       [Either String ()]
is_valid <- (WrappedCommand -> IO (Either String ()))
-> [WrappedCommand] -> IO [Either String ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                   (\(WrappedCommand c :: DarcsCommand parsedFlags
c)-> String -> IO (Either String ()) -> IO (Either String ())
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory String
here (IO (Either String ()) -> IO (Either String ()))
-> IO (Either String ()) -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ DarcsCommand parsedFlags -> [DarcsFlag] -> IO (Either String ())
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsFlag] -> IO (Either String ())
commandPrereq DarcsCommand parsedFlags
c [])
                   ([CommandControl] -> [WrappedCommand]
extractCommands [CommandControl]
commandControlList)
       String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((WrappedCommand, Either String ()) -> String)
-> [(WrappedCommand, Either String ())] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (WrappedCommand -> String
wrappedCommandName (WrappedCommand -> String)
-> ((WrappedCommand, Either String ()) -> WrappedCommand)
-> (WrappedCommand, Either String ())
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WrappedCommand, Either String ()) -> WrappedCommand
forall a b. (a, b) -> a
fst) ([(WrappedCommand, Either String ())] -> [String])
-> [(WrappedCommand, Either String ())] -> [String]
forall a b. (a -> b) -> a -> b
$
                ((WrappedCommand, Either String ()) -> Bool)
-> [(WrappedCommand, Either String ())]
-> [(WrappedCommand, Either String ())]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either String () -> Bool
forall a b. Either a b -> Bool
isRight(Either String () -> Bool)
-> ((WrappedCommand, Either String ()) -> Either String ())
-> (WrappedCommand, Either String ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(WrappedCommand, Either String ()) -> Either String ()
forall a b. (a, b) -> b
snd) ([(WrappedCommand, Either String ())]
 -> [(WrappedCommand, Either String ())])
-> [(WrappedCommand, Either String ())]
-> [(WrappedCommand, Either String ())]
forall a b. (a -> b) -> a -> b
$
                [WrappedCommand]
-> [Either String ()] -> [(WrappedCommand, Either String ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ([CommandControl] -> [WrappedCommand]
extractCommands [CommandControl]
commandControlList) [Either String ()]
is_valid
       String -> IO ()
putStrLn "--help"
       String -> IO ()
putStrLn "--version"
       String -> IO ()
putStrLn "--exact-version"
    where isRight :: Either a b -> Bool
isRight (Right _) = Bool
True
          isRight _ = Bool
False

printVersion :: IO ()
printVersion :: IO ()
printVersion = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "darcs version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version

-- avoiding a module import cycle between Help and TheCommands
commandControlList :: [CommandControl]
commandControlList :: [CommandControl]
commandControlList =
  DarcsCommand [DarcsFlag] -> CommandControl
forall parsedFlags. DarcsCommand parsedFlags -> CommandControl
normalCommand DarcsCommand [DarcsFlag]
help CommandControl -> [CommandControl] -> [CommandControl]
forall a. a -> [a] -> [a]
: [CommandControl]
TheCommands.commandControlList

-- FIXME: the "grouping" comments below should made subsections in the
-- manpage, as we already do for DarcsCommand groups. --twb, 2009

-- | Help on each environment variable in which Darcs is interested.
environmentHelp :: [([String], [String])]
environmentHelp :: [([String], [String])]
environmentHelp = [
 -- General-purpose
 ([String], [String])
environmentHelpHome,
 ([String], [String])
environmentHelpEditor,
 ([String], [String])
environmentHelpPager,
 ([String], [String])
environmentHelpColor,
 ([String], [String])
environmentHelpEscapeWhite,
 ([String], [String])
environmentHelpEscape,
 ([String], [String])
environmentHelpTmpdir,
 ([String], [String])
environmentHelpKeepTmpdir,
 ([String], [String])
environmentHelpEmail,
 ([String], [String])
environmentHelpSendmail,
 ([String], [String])
environmentHelpLocks,
 -- Remote Repositories
 ([String], [String])
environmentHelpSsh,
 ([String], [String])
environmentHelpScp,
 ([String], [String])
environmentHelpSshPort,
 ([String], [String])
environmentHelpProxy,
 ([String], [String])
environmentHelpProxyPassword,
 ([String], [String])
environmentHelpTimeout]

-- | This module is responsible for emitting a darcs "man-page", a
-- reference document used widely on Unix-like systems.  Manpages are
-- primarily used as a quick reference, or "memory jogger", so the
-- output should be terser than the user manual.
--
-- Before modifying the output, please be sure to read the man(7) and
-- man-pages(7) manpages, as these respectively describe the relevant
-- syntax and conventions.

-- | The lines of the manpage to be printed.
manpageLines :: [String]
manpageLines :: [String]
manpageLines = [
 ".TH DARCS 1 \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"",
 ".SH NAME",
 "darcs \\- an advanced revision control system",
 ".SH SYNOPSIS",
 ".B darcs", ".I command", ".RI < arguments |[ options ]>...",
 "",
 "Where the", ".I commands", "and their respective", ".I arguments", "are",
 "",
 [String] -> String
unlines [String]
synopsis,
 ".SH DESCRIPTION",
 -- FIXME: this is copy-and-pasted from darcs.cabal, so
 -- it'll get out of date as people forget to maintain
 -- both in sync.
 "Darcs is a free, open source revision control",
 "system. It is:",
 ".TP 3", "\\(bu",
 "Distributed: Every user has access to the full",
 "command set, removing boundaries between server and",
 "client or committer and non\\(hycommitters.",
 ".TP", "\\(bu",
 "Interactive: Darcs is easy to learn and efficient to",
 "use because it asks you questions in response to",
 "simple commands, giving you choices in your work",
 "flow. You can choose to record one change in a file,",
 "while ignoring another. As you update from upstream,",
 "you can review each patch name, even the full `diff'",
 "for interesting patches.",
 ".TP", "\\(bu",
 "Smart: Originally developed by physicist David",
 "Roundy, darcs is based on a unique algebra of",
 "patches.",
 "This smartness lets you respond to changing demands",
 "in ways that would otherwise not be possible. Learn",
 "more about spontaneous branches with darcs.",
 ".SH OPTIONS",
 "Different options are accepted by different Darcs commands.",
 "Each command's most important options are listed in the",
 ".B COMMANDS",
 "section.  For a full list of all options accepted by",
 "a particular command, run `darcs", ".I command", "\\-\\-help'.",
 ".SS " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape ([String] -> String
unlines [String]
helpOnMatchers), -- FIXME: this is a kludge.
 ".SH COMMANDS",
 [String] -> String
unlines [String]
commands,
 [String] -> String
unlines [String]
environment,
 ".SH FILES",
 [String] -> String
unlines [String]
prefFiles,
 ".SH BUGS",
 "At http://bugs.darcs.net/ you can find a list of known",
 "bugs in Darcs.  Unknown bugs can be reported at that",
 "site (after creating an account) or by emailing the",
 "report to bugs@darcs.net.",
 -- ".SH EXAMPLE",
 -- FIXME:
 -- new project: init, rec -la;
 -- track upstream project: clone, pull -a;
 -- contribute to project: add, rec, push/send.
 ".SH SEE ALSO",
 "The Darcs website provides a lot of additional information.",
 "It can be found at http://darcs.net/",
 ".SH LICENSE",
 "Darcs is free software; you can redistribute it and/or modify",
 "it under the terms of the GNU General Public License as published by",
 "the Free Software Foundation; either version 2, or (at your option)",
 "any later version." ]
    where
      -- | A synopsis line for each command.  Uses 'foldl' because it is
      -- necessary to avoid blank lines from Hidden_commands, as groff
      -- translates them into annoying vertical padding (unlike TeX).
      synopsis :: [String]
      synopsis :: [String]
synopsis = ([String] -> CommandControl -> [String])
-> [String] -> [CommandControl] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> CommandControl -> [String]
iter [] [CommandControl]
commandControlList
          where iter :: [String] -> CommandControl -> [String]
                iter :: [String] -> CommandControl -> [String]
iter acc :: [String]
acc (GroupName _) = [String]
acc
                iter acc :: [String]
acc (HiddenCommand _) = [String]
acc
                iter acc :: [String]
acc (CommandData (WrappedCommand c :: DarcsCommand parsedFlags
c@SuperCommand {})) =
                    [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (WrappedCommand -> [String]) -> [WrappedCommand] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (String -> WrappedCommand -> [String]
render (DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "))
                            ([CommandControl] -> [WrappedCommand]
extractCommands (DarcsCommand parsedFlags -> [CommandControl]
forall pf. DarcsCommand pf -> [CommandControl]
commandSubCommands DarcsCommand parsedFlags
c))
                iter acc :: [String]
acc (CommandData c :: WrappedCommand
c) = [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> WrappedCommand -> [String]
render "" WrappedCommand
c
                render :: String -> WrappedCommand -> [String]
                render :: String -> WrappedCommand -> [String]
render prefix :: String
prefix (WrappedCommand c :: DarcsCommand parsedFlags
c) =
                    [".B darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mangle_args (DarcsCommand parsedFlags -> [String]
forall parsedFlags. DarcsCommand parsedFlags -> [String]
commandExtraArgHelp DarcsCommand parsedFlags
c) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                    -- In the output, we want each command to be on its own
                    -- line, but we don't want blank lines between them.
                    -- AFAICT this can only be achieved with the .br
                    -- directive, which is probably a GNUism.
                    [".br"]

      -- | As 'synopsis', but make each group a subsection (.SS), and
      -- include the help text for each command.
      commands :: [String]
      commands :: [String]
commands = ([String] -> CommandControl -> [String])
-> [String] -> [CommandControl] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> CommandControl -> [String]
iter [] [CommandControl]
commandControlList
          where iter :: [String] -> CommandControl -> [String]
                iter :: [String] -> CommandControl -> [String]
iter acc :: [String]
acc (GroupName x :: String
x) = [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [".SS \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\""]
                iter acc :: [String]
acc (HiddenCommand _) = [String]
acc
                iter acc :: [String]
acc (CommandData (WrappedCommand c :: DarcsCommand parsedFlags
c@SuperCommand {})) =
                    [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (WrappedCommand -> [String]) -> [WrappedCommand] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                            (String -> WrappedCommand -> [String]
render (DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "))
                            ([CommandControl] -> [WrappedCommand]
extractCommands (DarcsCommand parsedFlags -> [CommandControl]
forall pf. DarcsCommand pf -> [CommandControl]
commandSubCommands DarcsCommand parsedFlags
c))
                iter acc :: [String]
acc (CommandData c :: WrappedCommand
c) = [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> WrappedCommand -> [String]
render "" WrappedCommand
c
                render :: String -> WrappedCommand -> [String]
                render :: String -> WrappedCommand -> [String]
render prefix :: String
prefix (WrappedCommand c :: DarcsCommand parsedFlags
c) =
                    [".B darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mangle_args (DarcsCommand parsedFlags -> [String]
forall parsedFlags. DarcsCommand parsedFlags -> [String]
commandExtraArgHelp DarcsCommand parsedFlags
c) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                    [".RS 4", String -> String
escape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandHelp DarcsCommand parsedFlags
c, ".RE"]

      -- | Now I'm showing off: mangle the extra arguments of Darcs commands
      -- so as to use the ideal format for manpages, italic words and roman
      -- punctuation.
      mangle_args :: String -> String
      mangle_args :: String -> String
mangle_args s :: String
s =
          ".RI " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show ((Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Char -> Char -> Bool
cmp (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
gank String
s))
              where cmp :: Char -> Char -> Bool
cmp x :: Char
x y :: Char
y = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
xor (Char -> Bool
isAlphaNum Char
x) (Char -> Bool
isAlphaNum Char
y)
                    xor :: Bool -> Bool -> Bool
xor x :: Bool
x y :: Bool
y = (Bool
x Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
y) Bool -> Bool -> Bool
|| (Bool
y Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
x)
                    gank :: String -> String
gank (' ':'o':'r':' ':xs :: String
xs) = '|' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
gank String
xs
                    gank (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
gank String
xs
                    gank [] = []

      environment :: [String]
      environment :: [String]
environment = ".SH ENVIRONMENT" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [(".SS \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
andClauses [String]
ks String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
escape [String]
ds
                     | (ks :: [String]
ks, ds :: [String]
ds) <- [([String], [String])]
environmentHelp]

      escape :: String -> String
      escape :: String -> String
escape = String -> String
minus (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
bs       -- Order is important
        where
          minus :: String -> String
minus      = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace "-"     "\\-"
          bs :: String -> String
bs         = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace "\\"    "\\\\"

          replace :: Eq a => [a] -> [a] -> [a] -> [a]
          replace :: [a] -> [a] -> [a] -> [a]
replace _ _ [] = []
          replace find :: [a]
find repl :: [a]
repl s :: [a]
s =
              if [a]
find [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
s
                  then [a]
repl [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
find [a]
repl (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
find) [a]
s)
                  else [a] -> a
forall a. [a] -> a
head [a]
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
find [a]
repl ([a] -> [a]
forall a. [a] -> [a]
tail [a]
s)

      prefFiles :: [String]
prefFiles = ((String, String) -> [String]) -> [(String, String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> [String]
go [(String, String)]
prefsFilesHelp
        where go :: (String, String) -> [String]
go (f :: String
f,h :: String
h) = [".SS \"_darcs/prefs/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"", String -> String
escape String
h]

markdownLines :: [String]
markdownLines :: [String]
markdownLines =
 [ "# Commands", ""
 , [String] -> String
unlines [String]
commands
 , "# Patterns"
 , "", [String] -> String
unlines [String]
helpOnMatchers
 , "# Configuration"
 , "", [String] -> String
unlines [String]
prefFiles
 , "# Environment variables"
 , "", [String] -> String
unlines [String]
environment ]
   where
      prefFiles :: [String]
prefFiles = ((String, String) -> [String]) -> [(String, String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> [String]
go [(String, String)]
prefsFilesHelp
        where go :: (String, String) -> [String]
go (f :: String
f,h :: String
h) = ["## `_darcs/prefs/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ "`", "", String
h]

      environment :: [String]
      environment :: [String]
environment = [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [""]
                     [ [String] -> [String] -> [String]
renderEnv [String]
ks [String]
ds | (ks :: [String]
ks, ds :: [String]
ds) <- [([String], [String])]
environmentHelp ]
        where
          renderEnv :: [String] -> [String] -> [String]
renderEnv k :: [String]
k d :: [String]
d = ("## " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
k)) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
d
      commands :: [String]
      commands :: [String]
commands = ([String] -> CommandControl -> [String])
-> [String] -> [CommandControl] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> CommandControl -> [String]
iter [] [CommandControl]
commandControlList
      iter :: [String] -> CommandControl -> [String]
      iter :: [String] -> CommandControl -> [String]
iter acc :: [String]
acc (GroupName x :: String
x) = [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["## " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x, ""]
      iter acc :: [String]
acc (HiddenCommand _) = [String]
acc
      iter acc :: [String]
acc (CommandData (WrappedCommand c :: DarcsCommand parsedFlags
c@SuperCommand {})) =
          [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (WrappedCommand -> [String]) -> [WrappedCommand] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                  (String -> WrappedCommand -> [String]
render (DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "))
                  ([CommandControl] -> [WrappedCommand]
extractCommands (DarcsCommand parsedFlags -> [CommandControl]
forall pf. DarcsCommand pf -> [CommandControl]
commandSubCommands DarcsCommand parsedFlags
c))
      iter acc :: [String]
acc (CommandData c :: WrappedCommand
c) = [String]
acc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> WrappedCommand -> [String]
render "" WrappedCommand
c
      render :: String -> WrappedCommand -> [String]
      render :: String -> WrappedCommand -> [String]
render prefix :: String
prefix (WrappedCommand c :: DarcsCommand parsedFlags
c) =
          [ "### " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c
          , "", "darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandName DarcsCommand parsedFlags
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " [OPTION]... " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          [String] -> String
unwords (DarcsCommand parsedFlags -> [String]
forall parsedFlags. DarcsCommand parsedFlags -> [String]
commandExtraArgHelp DarcsCommand parsedFlags
c)
          , "", DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandDescription DarcsCommand parsedFlags
c
          , "", DarcsCommand parsedFlags -> String
forall pf. DarcsCommand pf -> String
commandHelp DarcsCommand parsedFlags
c
          , "Options:", [DarcsOptDescr DarcsFlag] -> String
forall f. [DarcsOptDescr f] -> String
optionsMarkdown ([DarcsOptDescr DarcsFlag] -> String)
-> [DarcsOptDescr DarcsFlag] -> String
forall a b. (a -> b) -> a -> b
$ DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag]
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag]
commandBasicOptions DarcsCommand parsedFlags
c
          , if [DarcsOptDescr DarcsFlag] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DarcsOptDescr DarcsFlag]
opts2 then ""
             else [String] -> String
unlines ["Advanced Options:", [DarcsOptDescr DarcsFlag] -> String
forall f. [DarcsOptDescr f] -> String
optionsMarkdown [DarcsOptDescr DarcsFlag]
opts2]
          ]
       where opts2 :: [DarcsOptDescr DarcsFlag]
opts2 = DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag]
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag]
commandAdvancedOptions DarcsCommand parsedFlags
c

environmentHelpEditor :: ([String], [String])
environmentHelpEditor :: ([String], [String])
environmentHelpEditor = (["DARCS_EDITOR", "VISUAL", "EDITOR"],[
 "To edit a patch description of email comment, Darcs will invoke an",
 "external editor.  Your preferred editor can be set as any of the",
 "environment variables $DARCS_EDITOR, $VISUAL or $EDITOR.",
 "If none of these are set, nano is used.  If nano crashes or is not",
 "found in your PATH, vi, emacs, emacs -nw and (on Windows) edit are",
 "each tried in turn."])

environmentHelpPager :: ([String], [String])
environmentHelpPager :: ([String], [String])
environmentHelpPager = (["DARCS_PAGER", "PAGER"],[
 "Darcs will invoke a pager if the output of some command is longer",
 "than 20 lines. Darcs will use the pager specified by $DARCS_PAGER",
 "or $PAGER.  If neither are set, `less` will be used."])

environmentHelpTimeout :: ([String], [String])
environmentHelpTimeout :: ([String], [String])
environmentHelpTimeout = (["DARCS_CONNECTION_TIMEOUT"],[
 "Set the maximum time in seconds that darcs allows and connection to",
 "take. If the variable is not specified the default are 30 seconds.",
 "This option only works with curl."])

-- | There are two environment variables that we do not document:
-- - DARCS_USE_ISPRINT: deprecated, use DARCS_DONT_ESCAPE_ISPRINT.
-- - DARCS_TESTING_PREFS_DIR: used by the test suite to tell darcs
--                            where to find its configuration files.