module Distribution.Client.Manpage
(
manpage
, manpageCmd
, ManpageFlags
, defaultManpageFlags
, manpageOptions
) where
import qualified Data.List.NonEmpty as List1
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.Errors
import Distribution.Client.Init.Utils (trim)
import Distribution.Client.ManpageFlags
import Distribution.Client.Setup (globalCommand)
import Distribution.Compat.Process (proc)
import Distribution.Simple.Command
import Distribution.Simple.Flag (fromFlag, fromFlagOrDefault)
import Distribution.Simple.Utils
( IOData (..)
, IODataMode (..)
, dieWithException
, fromCreatePipe
, ignoreSigPipe
, rawSystemProcAction
, rawSystemStdInOut
)
import System.Environment (lookupEnv)
import System.IO (hClose, hPutStr)
import qualified System.Process as Process
data FileInfo
=
FileInfo String String
files :: [FileInfo]
files :: [FileInfo]
files =
[ (String -> String -> FileInfo
FileInfo String
"~/.config/cabal/config" String
"The defaults that can be overridden with command-line options.")
]
manpageCmd :: String -> [CommandSpec a] -> ManpageFlags -> IO ()
manpageCmd :: forall a. String -> [CommandSpec a] -> ManpageFlags -> IO ()
manpageCmd String
pname [CommandSpec a]
commands ManpageFlags
flags
| Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ManpageFlags -> Flag Bool
manpageRaw ManpageFlags
flags) =
String -> IO ()
putStrLn String
contents
| Bool
otherwise =
IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(String
formatted, String
_errors, ExitCode
ec1) <-
Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode String
-> IO (String, String, ExitCode)
forall mode.
KnownIODataMode mode =>
Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe IOData
-> IODataMode mode
-> IO (mode, String, ExitCode)
rawSystemStdInOut
Verbosity
verbosity
String
"nroff"
[String
"-man", String
"/dev/stdin"]
Maybe String
forall a. Maybe a
Nothing
Maybe [(String, String)]
forall a. Maybe a
Nothing
(IOData -> Maybe IOData
forall a. a -> Maybe a
Just (IOData -> Maybe IOData) -> IOData -> Maybe IOData
forall a b. (a -> b) -> a -> b
$ String -> IOData
IODataText String
contents)
IODataMode String
IODataModeText
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
ec1 ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
ec1
String
pagerAndArgs <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"less -R" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PAGER"
(String
pager, [String]
pagerArgs) <- case String -> [String]
words String
pagerAndArgs of
[] -> Verbosity -> CabalInstallException -> IO (String, [String])
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
EmptyValuePagerEnvVariable
(String
p : [String]
pa) -> (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
p, [String]
pa)
(ExitCode
ec2, ()
_) <- Verbosity
-> CreateProcess
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
-> IO (ExitCode, ())
forall a.
Verbosity
-> CreateProcess
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
-> IO (ExitCode, a)
rawSystemProcAction
Verbosity
verbosity
(String -> [String] -> CreateProcess
proc String
pager [String]
pagerArgs){Process.std_in = Process.CreatePipe}
((Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
-> IO (ExitCode, ()))
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ())
-> IO (ExitCode, ())
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
mIn Maybe Handle
_ Maybe Handle
_ -> do
let wIn :: Handle
wIn = Maybe Handle -> Handle
fromCreatePipe Maybe Handle
mIn
Handle -> String -> IO ()
hPutStr Handle
wIn String
formatted
Handle -> IO ()
hClose Handle
wIn
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
ec2
where
contents :: String
contents :: String
contents = String -> [CommandSpec a] -> String
forall a. String -> [CommandSpec a] -> String
manpage String
pname [CommandSpec a]
commands
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ManpageFlags -> Flag Verbosity
manpageVerbosity ManpageFlags
flags
manpage :: String -> [CommandSpec a] -> String
manpage :: forall a. String -> [CommandSpec a] -> String
manpage String
pname [CommandSpec a]
commands =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
".TH " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 1"
, String
".SH NAME"
, String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" \\- a system for building and packaging Haskell libraries and programs"
, String
".SH SYNOPSIS"
, String
".B " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
, String
".I command"
, String
".RI < arguments |[ options ]>..."
, String
""
, String
"Where the"
, String
".I commands"
, String
"are"
, String
""
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (CommandSpec a -> [String]) -> [CommandSpec a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> CommandSpec a -> [String]
forall action. String -> CommandSpec action -> [String]
commandSynopsisLines String
pname) [CommandSpec a]
commands
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
".SH DESCRIPTION"
, String
"Cabal is the standard package system for Haskell software. It helps people to configure, "
, String
"build and install Haskell software and to distribute it easily to other users and developers."
, String
""
, String
"The command line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tool (also referred to as cabal-install) helps with "
, String
"installing existing packages and developing new packages. "
, String
"It can be used to work with local packages or to install packages from online package archives, "
, String
"including automatically installing dependencies. By default it is configured to use Hackage, "
, String
"which is Haskell's central package archive that contains thousands of libraries and applications "
, String
"in the Cabal package format."
, String
".SH OPTIONS"
, String
"Global options:"
, String
""
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CommandUI GlobalFlags -> [String]
forall flags. CommandUI flags -> [String]
optionsLines ([Command Any] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand [])
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
".SH COMMANDS"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (CommandSpec a -> [String]) -> [CommandSpec a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> CommandSpec a -> [String]
forall action. String -> CommandSpec action -> [String]
commandDetailsLines String
pname) [CommandSpec a]
commands
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
".SH FILES"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (FileInfo -> [String]) -> [FileInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileInfo -> [String]
fileLines [FileInfo]
files
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
".SH BUGS"
, String
"To browse the list of known issues or report a new one please see "
, String
"https://github.com/haskell/cabal/labels/cabal-install."
]
commandSynopsisLines :: String -> CommandSpec action -> [String]
commandSynopsisLines :: forall action. String -> CommandSpec action -> [String]
commandSynopsisLines String
pname (CommandSpec CommandUI flags
ui CommandUI flags -> Command action
_ CommandType
NormalCommand) =
[ String
".B " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (CommandUI flags -> String
forall flags. CommandUI flags -> String
commandName CommandUI flags
ui)
, String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CommandUI flags -> String
forall flags. CommandUI flags -> String
commandSynopsis CommandUI flags
ui
, String
".br"
]
commandSynopsisLines String
_ (CommandSpec CommandUI flags
_ CommandUI flags -> Command action
_ CommandType
HiddenCommand) = []
commandDetailsLines :: String -> CommandSpec action -> [String]
commandDetailsLines :: forall action. String -> CommandSpec action -> [String]
commandDetailsLines String
pname (CommandSpec CommandUI flags
ui CommandUI flags -> Command action
_ CommandType
NormalCommand) =
[ String
".B " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (CommandUI flags -> String
forall flags. CommandUI flags -> String
commandName CommandUI flags
ui)
, String
""
, CommandUI flags -> String -> String
forall flags. CommandUI flags -> String -> String
commandUsage CommandUI flags
ui String
pname
, String
""
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String)
-> (CommandUI flags -> Maybe (String -> String)) -> [String]
forall {a}.
(a -> String)
-> (CommandUI flags -> Maybe (String -> a)) -> [String]
optional String -> String
removeLineBreaks CommandUI flags -> Maybe (String -> String)
forall flags. CommandUI flags -> Maybe (String -> String)
commandDescription
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String)
-> (CommandUI flags -> Maybe (String -> String)) -> [String]
forall {a}.
(a -> String)
-> (CommandUI flags -> Maybe (String -> a)) -> [String]
optional String -> String
forall a. a -> a
id CommandUI flags -> Maybe (String -> String)
forall flags. CommandUI flags -> Maybe (String -> String)
commandNotes
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"Flags:"
, String
".RS"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CommandUI flags -> [String]
forall flags. CommandUI flags -> [String]
optionsLines CommandUI flags
ui
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
".RE"
, String
""
]
where
optional :: (a -> String)
-> (CommandUI flags -> Maybe (String -> a)) -> [String]
optional a -> String
f CommandUI flags -> Maybe (String -> a)
field =
case CommandUI flags -> Maybe (String -> a)
field CommandUI flags
ui of
Just String -> a
text -> [a -> String
f (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ String -> a
text String
pname, String
""]
Maybe (String -> a)
Nothing -> []
removeLineBreaks :: String -> String
removeLineBreaks =
[String] -> String
unlines
([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty String -> [String]) -> [NonEmpty String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty String -> [String]
unwordsNonEmpty
([NonEmpty String] -> [String])
-> (String -> [NonEmpty String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [NonEmpty String]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
List1.groupWith String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
([String] -> [NonEmpty String])
-> (String -> [String]) -> String -> [NonEmpty String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
trim
([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
unwordsNonEmpty :: List1.NonEmpty String -> [String]
unwordsNonEmpty :: NonEmpty String -> [String]
unwordsNonEmpty NonEmpty String
ls1 = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NonEmpty String -> String
forall a. NonEmpty a -> a
List1.head NonEmpty String
ls1) then [String]
ls else [[String] -> String
unwords [String]
ls]
where
ls :: [String]
ls = NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
List1.toList NonEmpty String
ls1
commandDetailsLines String
_ (CommandSpec CommandUI flags
_ CommandUI flags -> Command action
_ CommandType
HiddenCommand) = []
optionsLines :: CommandUI flags -> [String]
optionsLines :: forall flags. CommandUI flags -> [String]
optionsLines CommandUI flags
command = (OptDescr flags -> [String]) -> [OptDescr flags] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptDescr flags -> [String]
forall flags. OptDescr flags -> [String]
optionLines ((OptionField flags -> [OptDescr flags])
-> [OptionField flags] -> [OptDescr flags]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptionField flags -> [OptDescr flags]
forall a. OptionField a -> [OptDescr a]
optionDescr (CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
forall flags.
CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
commandOptions CommandUI flags
command ShowOrParseArgs
ParseArgs))
data ArgumentRequired = Optional | Required
type OptionArg = (ArgumentRequired, ArgPlaceHolder)
optionLines :: OptDescr flags -> [String]
optionLines :: forall flags. OptDescr flags -> [String]
optionLines (ReqArg String
description (String
optionChars, [String]
optionStrings) String
placeHolder ReadE (flags -> flags)
_ flags -> [String]
_) =
String -> String -> [String] -> OptionArg -> [String]
argOptionLines String
description String
optionChars [String]
optionStrings (ArgumentRequired
Required, String
placeHolder)
optionLines (OptArg String
description (String
optionChars, [String]
optionStrings) String
placeHolder ReadE (flags -> flags)
_ (String, flags -> flags)
_ flags -> [Maybe String]
_) =
String -> String -> [String] -> OptionArg -> [String]
argOptionLines String
description String
optionChars [String]
optionStrings (ArgumentRequired
Optional, String
placeHolder)
optionLines (BoolOpt String
description (String
trueChars, [String]
trueStrings) (String
falseChars, [String]
falseStrings) Bool -> flags -> flags
_ flags -> Maybe Bool
_) =
String -> [String] -> [String]
optionLinesIfPresent String
trueChars [String]
trueStrings
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String] -> [String]
optionLinesIfPresent String
falseChars [String]
falseStrings
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
optionDescriptionLines String
description
optionLines (ChoiceOpt [(String, (String, [String]), flags -> flags, flags -> Bool)]
options) =
((String, (String, [String]), flags -> flags, flags -> Bool)
-> [String])
-> [(String, (String, [String]), flags -> flags, flags -> Bool)]
-> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, (String, [String]), flags -> flags, flags -> Bool)
-> [String]
forall {c} {d}. (String, (String, [String]), c, d) -> [String]
choiceLines [(String, (String, [String]), flags -> flags, flags -> Bool)]
options
where
choiceLines :: (String, (String, [String]), c, d) -> [String]
choiceLines (String
description, (String
optionChars, [String]
optionStrings), c
_, d
_) =
[String -> [String] -> String
optionsLine String
optionChars [String]
optionStrings]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
optionDescriptionLines String
description
argOptionLines :: String -> [Char] -> [String] -> OptionArg -> [String]
argOptionLines :: String -> String -> [String] -> OptionArg -> [String]
argOptionLines String
description String
optionChars [String]
optionStrings OptionArg
arg =
[ String -> [String] -> String
optionsLine String
optionChars [String]
optionStrings
, OptionArg -> String
optionArgLine OptionArg
arg
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
optionDescriptionLines String
description
optionLinesIfPresent :: [Char] -> [String] -> [String]
optionLinesIfPresent :: String -> [String] -> [String]
optionLinesIfPresent String
optionChars [String]
optionStrings =
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
optionChars Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optionStrings
then []
else [String -> [String] -> String
optionsLine String
optionChars [String]
optionStrings, String
".br"]
optionDescriptionLines :: String -> [String]
optionDescriptionLines :: String -> [String]
optionDescriptionLines String
description =
[ String
".RS"
, String
description
, String
".RE"
, String
""
]
optionsLine :: [Char] -> [String] -> String
optionsLine :: String -> [String] -> String
optionsLine String
optionChars [String]
optionStrings =
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String -> [String]
shortOptions String
optionChars [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
longOptions [String]
optionStrings)
shortOptions :: [Char] -> [String]
shortOptions :: String -> [String]
shortOptions = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> String
"\\-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c])
longOptions :: [String] -> [String]
longOptions :: [String] -> [String]
longOptions = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"\\-\\-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
optionArgLine :: OptionArg -> String
optionArgLine :: OptionArg -> String
optionArgLine (ArgumentRequired
Required, String
placeHolder) = String
".I " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
placeHolder
optionArgLine (ArgumentRequired
Optional, String
placeHolder) = String
".RI [ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
placeHolder String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ]"
fileLines :: FileInfo -> [String]
fileLines :: FileInfo -> [String]
fileLines (FileInfo String
path String
description) =
[ String
path
, String
".RS"
, String
description
, String
".RE"
, String
""
]