{-# LANGUAGE CPP #-}
module Distribution.Client.Manpage
(
manpage
, manpageCmd
, ManpageFlags
, defaultManpageFlags
, manpageOptions
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Data.List.NonEmpty as List1
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(..), ignoreSigPipe, rawSystemStdInOut, rawSystemProcAction,
fromCreatePipe, die' )
import System.IO (hClose, hPutStr)
import System.Environment (lookupEnv)
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
| 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 forall a b. (a -> b) -> a -> b
$ do
(String
formatted, String
_errors, ExitCode
ec1) <- 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" ]
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> IOData
IODataText String
contents)
IODataMode String
IODataModeText
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
ec1 forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) forall a b. (a -> b) -> a -> b
$ forall a. ExitCode -> IO a
exitWith ExitCode
ec1
String
pagerAndArgs <- forall a. a -> Maybe a -> a
fromMaybe String
"less -R" 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
[] -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"man: empty value of the PAGER environment variable"
(String
p:[String]
pa) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
p, [String]
pa)
(ExitCode
ec2, ()
_) <- 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) { std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe }
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
forall a. ExitCode -> IO a
exitWith ExitCode
ec2
where
contents :: String
contents :: String
contents = forall a. String -> [CommandSpec a] -> String
manpage String
pname [CommandSpec a]
commands
verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag 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 forall a b. (a -> b) -> a -> b
$
[ String
".TH " forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
pname forall a. [a] -> [a] -> [a]
++ String
" 1"
, String
".SH NAME"
, String
pname forall a. [a] -> [a] -> [a]
++ String
" \\- a system for building and packaging Haskell libraries and programs"
, String
".SH SYNOPSIS"
, String
".B " forall a. [a] -> [a] -> [a]
++ String
pname
, String
".I command"
, String
".RI < arguments |[ options ]>..."
, String
""
, String
"Where the"
, String
".I commands"
, String
"are"
, String
""
] forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall action. String -> CommandSpec action -> [String]
commandSynopsisLines String
pname) [CommandSpec a]
commands 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 " forall a. [a] -> [a] -> [a]
++ String
pname 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
""
] forall a. [a] -> [a] -> [a]
++
forall flags. CommandUI flags -> [String]
optionsLines (forall action. [Command action] -> CommandUI GlobalFlags
globalCommand []) forall a. [a] -> [a] -> [a]
++
[ String
".SH COMMANDS"
] forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall action. String -> CommandSpec action -> [String]
commandDetailsLines String
pname) [CommandSpec a]
commands forall a. [a] -> [a] -> [a]
++
[ String
".SH FILES"
] forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileInfo -> [String]
fileLines [FileInfo]
files 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 " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (forall flags. CommandUI flags -> String
commandName CommandUI flags
ui)
, String
"- " forall a. [a] -> [a] -> [a]
++ 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 " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (forall flags. CommandUI flags -> String
commandName CommandUI flags
ui)
, String
""
, forall flags. CommandUI flags -> String -> String
commandUsage CommandUI flags
ui String
pname
, String
""
] forall a. [a] -> [a] -> [a]
++
forall {a}.
(a -> String)
-> (CommandUI flags -> Maybe (String -> a)) -> [String]
optional String -> String
removeLineBreaks forall flags. CommandUI flags -> Maybe (String -> String)
commandDescription forall a. [a] -> [a] -> [a]
++
forall {a}.
(a -> String)
-> (CommandUI flags -> Maybe (String -> a)) -> [String]
optional forall a. a -> a
id forall flags. CommandUI flags -> Maybe (String -> String)
commandNotes forall a. [a] -> [a] -> [a]
++
[ String
"Flags:"
, String
".RS"
] forall a. [a] -> [a] -> [a]
++
forall flags. CommandUI flags -> [String]
optionsLines CommandUI flags
ui 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 forall a b. (a -> b) -> a -> b
$ String -> a
text String
pname, String
"" ]
Maybe (String -> a)
Nothing -> []
removeLineBreaks :: String -> String
removeLineBreaks
= [String] -> String
unlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty String -> [String]
unwordsNonEmpty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
List1.groupWith forall (t :: * -> *) a. Foldable t => t a -> Bool
null
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
trim
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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. NonEmpty a -> a
List1.head NonEmpty String
ls1) then [String]
ls else [[String] -> String
unwords [String]
ls]
where ls :: [String]
ls = 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall flags. OptDescr flags -> [String]
optionLines (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. OptionField a -> [OptDescr a]
optionDescr (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)
_ 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 forall a. [a] -> [a] -> [a]
++
String -> [String] -> [String]
optionLinesIfPresent String
falseChars [String]
falseStrings forall a. [a] -> [a] -> [a]
++
String -> [String]
optionDescriptionLines String
description
optionLines (ChoiceOpt [(String, (String, [String]), flags -> flags, flags -> Bool)]
options) =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 ] 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
] forall a. [a] -> [a] -> [a]
++
String -> [String]
optionDescriptionLines String
description
optionLinesIfPresent :: [Char] -> [String] -> [String]
optionLinesIfPresent :: String -> [String] -> [String]
optionLinesIfPresent String
optionChars [String]
optionStrings =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
optionChars Bool -> Bool -> 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 =
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String -> [String]
shortOptions String
optionChars forall a. [a] -> [a] -> [a]
++ [String] -> [String]
longOptions [String]
optionStrings)
shortOptions :: [Char] -> [String]
shortOptions :: String -> [String]
shortOptions = forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> String
"\\-" forall a. [a] -> [a] -> [a]
++ [Char
c])
longOptions :: [String] -> [String]
longOptions :: [String] -> [String]
longOptions = forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"\\-\\-" forall a. [a] -> [a] -> [a]
++ String
s)
optionArgLine :: OptionArg -> String
optionArgLine :: OptionArg -> String
optionArgLine (ArgumentRequired
Required, String
placeHolder) = String
".I " forall a. [a] -> [a] -> [a]
++ String
placeHolder
optionArgLine (ArgumentRequired
Optional, String
placeHolder) = String
".RI [ " forall a. [a] -> [a] -> [a]
++ String
placeHolder 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
""
]