{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Usage
( getCommandHelp
, getSuperCommandHelp
, getCommandMiniHelp
, usage
, subusage
) where
import Darcs.Prelude
import Data.Functor.Compose
import System.Console.GetOpt( OptDescr(..), ArgDescr(..) )
import Darcs.UI.Options.All ( stdCmdActions )
import Darcs.UI.Commands
( CommandControl(..)
, DarcsCommand(..)
, commandName
, commandDescription
, getSubcommands
, commandAlloptions
)
import Darcs.UI.Options ( DarcsOptDescr, odesc )
import Darcs.Util.Printer
( Doc, text, vsep, ($$), vcat, hsep
, renderString
)
formatOptions :: [DarcsOptDescr a] -> [String]
formatOptions :: forall a. [DarcsOptDescr a] -> [String]
formatOptions [DarcsOptDescr a]
optDescrs = [String]
table
where ([String]
ss,[[String]]
ls,[String]
ds) = (forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. DarcsOptDescr a -> [(String, [String], String)]
fmtOpt) [DarcsOptDescr a]
optDescrs
table :: [String]
table = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 String -> String -> String -> String
paste
[String]
shortPadded
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unlines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init) [[String]]
ls)
([String] -> [String]
sameLen forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
last [[String]]
ls))
[String]
ds
shortPadded :: [String]
shortPadded = [String] -> [String]
sameLen [String]
ss
prePad :: String
prePad = forall a. Int -> a -> [a]
replicate (Int
3 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. [a] -> a
head [String]
shortPadded)) Char
' '
unlines' :: [String] -> String
unlines' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
x -> String
x forall a. [a] -> [a] -> [a]
++ String
",\n" forall a. [a] -> [a] -> [a]
++ String
prePad)
paste :: String -> String -> String -> String
paste String
x String
y String
z = String
" " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
y forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
z
sameLen :: [String] -> [String]
sameLen [String]
xs = Int -> [String] -> [String]
flushLeft ((forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
xs) [String]
xs
flushLeft :: Int -> [String] -> [String]
flushLeft Int
n [String]
xs = [ forall a. Int -> [a] -> [a]
take Int
n (String
x forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ') | String
x <- [String]
xs ]
fmtOpt :: DarcsOptDescr a -> [(String,[String],String)]
fmtOpt :: forall a. DarcsOptDescr a -> [(String, [String], String)]
fmtOpt (Compose (Option String
sos [String]
los ArgDescr (AbsolutePath -> a)
ad String
descr)) =
case String -> [String]
lines String
descr of
[] -> [(String
sosFmt,[String]
losFmt,String
"")]
(String
d:[String]
ds) -> (String
sosFmt,[String]
losFmt,String
d) forall a. a -> [a] -> [a]
: [ (String
"",[],String
d') | String
d' <- [String]
ds ]
where endBy :: Char -> [String] -> String
endBy Char
_ [] = String
""
endBy Char
ch [String
x] = String
x forall a. [a] -> [a] -> [a]
++ [Char
ch]
endBy Char
ch (String
x:[String]
xs) = String
x forall a. [a] -> [a] -> [a]
++ Char
chforall a. a -> [a] -> [a]
:Char
' 'forall a. a -> [a] -> [a]
:Char -> [String] -> String
endBy Char
ch [String]
xs
sosFmt :: String
sosFmt = Char -> [String] -> String
endBy Char
',' (forall a b. (a -> b) -> [a] -> [b]
map Char -> String
fmtShort String
sos)
losFmt :: [String]
losFmt = forall a b. (a -> b) -> [a] -> [b]
map (forall a. ArgDescr a -> String -> String
fmtLong ArgDescr (AbsolutePath -> a)
ad) [String]
los
fmtShort :: Char -> String
fmtShort :: Char -> String
fmtShort Char
so = String
"-" forall a. [a] -> [a] -> [a]
++ [Char
so]
fmtLong :: ArgDescr a -> String -> String
fmtLong :: forall a. ArgDescr a -> String -> String
fmtLong (NoArg a
_ ) String
lo = String
"--" forall a. [a] -> [a] -> [a]
++ String
lo
fmtLong (ReqArg String -> a
_ String
ad) String
lo = String
"--" forall a. [a] -> [a] -> [a]
++ String
lo forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
ad
fmtLong (OptArg Maybe String -> a
_ String
ad) String
lo = String
"--" forall a. [a] -> [a] -> [a]
++ String
lo forall a. [a] -> [a] -> [a]
++ String
"[=" forall a. [a] -> [a] -> [a]
++ String
ad forall a. [a] -> [a] -> [a]
++ String
"]"
usage :: [CommandControl] -> Doc
usage :: [CommandControl] -> Doc
usage [CommandControl]
cs = [Doc] -> Doc
vsep
[ Doc
"Usage: darcs COMMAND ..."
, Doc
"Commands:" Doc -> Doc -> Doc
$$ [CommandControl] -> Doc
usageHelper [CommandControl]
cs
, [Doc] -> Doc
vcat
[ Doc
"Use 'darcs help COMMAND' or 'darcs COMMAND --help' for help on a single command."
, Doc
"Use 'darcs help patterns' for help on patch matching."
, Doc
"Use 'darcs help environment' for help on environment variables."
, Doc
"Use 'darcs help manpage' to display help in the manpage format."
, Doc
"Use 'darcs help markdown' to display help in the markdown format."
, Doc
"Use 'darcs --version' to see the darcs version number."
, Doc
"Use 'darcs --exact-version' to see a detailed darcs version."
]
, Doc
"Check bug reports at http://bugs.darcs.net/"
]
subusage :: DarcsCommand -> Doc
subusage :: DarcsCommand -> Doc
subusage DarcsCommand
super = [Doc] -> Doc
vsep
[ DarcsCommand -> Doc
superUsage DarcsCommand
super Doc -> Doc -> Doc
$$ String -> Doc
text (DarcsCommand -> String
commandDescription DarcsCommand
super)
, [CommandControl] -> Doc
usageHelper (DarcsCommand -> [CommandControl]
getSubcommands DarcsCommand
super)
, Doc
"Options:"
, [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. [DarcsOptDescr a] -> [String]
formatOptions forall a b. (a -> b) -> a -> b
$ forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption (Maybe StdCmdAction)
stdCmdActions
, DarcsCommand -> Doc
commandHelp DarcsCommand
super
]
superUsage :: DarcsCommand -> Doc
superUsage :: DarcsCommand -> Doc
superUsage DarcsCommand
super = [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[ String
"Usage:"
, DarcsCommand -> String
commandProgramName DarcsCommand
super
, DarcsCommand -> String
commandName DarcsCommand
super
, String
"SUBCOMMAND [OPTION]..."
]
usageHelper :: [CommandControl] -> Doc
usageHelper :: [CommandControl] -> Doc
usageHelper [CommandControl]
xs = [Doc] -> Doc
vsep ([CommandControl] -> [Doc]
groups [CommandControl]
xs)
where
groups :: [CommandControl] -> [Doc]
groups [] = []
groups (HiddenCommand DarcsCommand
_:[CommandControl]
cs) = [CommandControl] -> [Doc]
groups [CommandControl]
cs
groups (GroupName String
n:[CommandControl]
cs) =
forall a. Monoid a => a
mempty forall a. a -> [a] -> [a]
: case [CommandControl] -> [Doc]
groups [CommandControl]
cs of
[] -> [String -> Doc
text String
n]
(Doc
g:[Doc]
gs) -> (String -> Doc
text String
n Doc -> Doc -> Doc
$$ Doc
g) forall a. a -> [a] -> [a]
: [Doc]
gs
groups (CommandData DarcsCommand
c:[CommandControl]
cs) =
case [CommandControl] -> [Doc]
groups [CommandControl]
cs of
[] -> [DarcsCommand -> Doc
cmdHelp DarcsCommand
c]
(Doc
g:[Doc]
gs) -> (DarcsCommand -> Doc
cmdHelp DarcsCommand
c Doc -> Doc -> Doc
$$ Doc
g) forall a. a -> [a] -> [a]
: [Doc]
gs
cmdHelp :: DarcsCommand -> Doc
cmdHelp DarcsCommand
c = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
" " forall a. [a] -> [a] -> [a]
++
Int -> String -> String
padSpaces Int
maxwidth (DarcsCommand -> String
commandName DarcsCommand
c) forall a. [a] -> [a] -> [a]
++
DarcsCommand -> String
commandDescription DarcsCommand
c
padSpaces :: Int -> String -> String
padSpaces Int
n String
s = String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '
maxwidth :: Int
maxwidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Int
15 forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map CommandControl -> Int
cwidth [CommandControl]
xs)
cwidth :: CommandControl -> Int
cwidth (CommandData DarcsCommand
c) = forall (t :: * -> *) a. Foldable t => t a -> Int
length (DarcsCommand -> String
commandName DarcsCommand
c) forall a. Num a => a -> a -> a
+ Int
2
cwidth CommandControl
_ = Int
0
getCommandMiniHelp :: Maybe DarcsCommand -> DarcsCommand -> String
getCommandMiniHelp :: Maybe DarcsCommand -> DarcsCommand -> String
getCommandMiniHelp Maybe DarcsCommand
msuper DarcsCommand
cmd = Doc -> String
renderString forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep
[ Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelpCore Maybe DarcsCommand
msuper DarcsCommand
cmd
, [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[ String
"See"
, DarcsCommand -> String
commandProgramName DarcsCommand
cmd
, String
"help"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((forall a. [a] -> [a] -> [a]
++ String
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. DarcsCommand -> String
commandName) Maybe DarcsCommand
msuper forall a. [a] -> [a] -> [a]
++ DarcsCommand -> String
commandName DarcsCommand
cmd
, String
"for details."
]
]
getCommandHelp :: Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelp :: Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelp Maybe DarcsCommand
msuper DarcsCommand
cmd = [Doc] -> Doc
vsep
[ Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelpCore Maybe DarcsCommand
msuper DarcsCommand
cmd
, Doc
subcommandsHelp
, String -> [String] -> Doc
withHeading String
"Options:" [String]
basicOptionsHelp
, String -> [String] -> Doc
withHeading String
"Advanced options:" [String]
advancedOptionsHelp
, DarcsCommand -> Doc
commandHelp DarcsCommand
cmd
]
where
withHeading :: String -> [String] -> Doc
withHeading String
_ [] = forall a. Monoid a => a
mempty
withHeading String
h [String]
ls = [Doc] -> Doc
vcat (String -> Doc
text String
h forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
ls)
([DarcsOptDescr DarcsFlag]
basic, [DarcsOptDescr DarcsFlag]
advanced) = DarcsCommand
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions DarcsCommand
cmd
([String]
basicOptionsHelp, [String]
advancedOptionsHelp) =
forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DarcsOptDescr DarcsFlag]
basic) forall a b. (a -> b) -> a -> b
$ forall a. [DarcsOptDescr a] -> [String]
formatOptions ([DarcsOptDescr DarcsFlag]
basic forall a. [a] -> [a] -> [a]
++ [DarcsOptDescr DarcsFlag]
advanced)
subcommandsHelp :: Doc
subcommandsHelp =
case Maybe DarcsCommand
msuper of
Maybe DarcsCommand
Nothing -> [CommandControl] -> Doc
usageHelper (DarcsCommand -> [CommandControl]
getSubcommands DarcsCommand
cmd)
Just DarcsCommand
_ -> forall a. Monoid a => a
mempty
getSuperCommandHelp :: DarcsCommand -> Doc
getSuperCommandHelp :: DarcsCommand -> Doc
getSuperCommandHelp DarcsCommand
super =
[Doc] -> Doc
vsep [DarcsCommand -> Doc
superUsage DarcsCommand
super, [CommandControl] -> Doc
usageHelper (DarcsCommand -> [CommandControl]
getSubcommands DarcsCommand
super), DarcsCommand -> Doc
commandHelp DarcsCommand
super]
getCommandHelpCore :: Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelpCore :: Maybe DarcsCommand -> DarcsCommand -> Doc
getCommandHelpCore Maybe DarcsCommand
msuper DarcsCommand
cmd = [Doc] -> Doc
vcat
[ [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$
[ Doc
"Usage:"
, String -> Doc
text forall a b. (a -> b) -> a -> b
$ DarcsCommand -> String
commandProgramName DarcsCommand
cmd
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. DarcsCommand -> String
commandName) Maybe DarcsCommand
msuper
, String -> Doc
text forall a b. (a -> b) -> a -> b
$ DarcsCommand -> String
commandName DarcsCommand
cmd
, Doc
"[OPTION]..."
]
forall a. [a] -> [a] -> [a]
++ [Doc]
args_help
, String -> Doc
text forall a b. (a -> b) -> a -> b
$ DarcsCommand -> String
commandDescription DarcsCommand
cmd
]
where
args_help :: [Doc]
args_help = case DarcsCommand
cmd of
(DarcsCommand {}) -> forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall a b. (a -> b) -> a -> b
$ DarcsCommand -> [String]
commandExtraArgHelp DarcsCommand
cmd
DarcsCommand
_ -> []