{-# 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.Simple.Command
import Distribution.Simple.Flag (fromFlagOrDefault)
import Distribution.Simple.Utils
( IOData(..), IODataMode(..), createProcessWithEnv, ignoreSigPipe, rawSystemStdInOut )
import qualified Distribution.Verbosity as Verbosity
import System.IO (hClose, hPutStr)
import System.Environment (lookupEnv)
import System.FilePath (takeFileName)
import qualified System.Process as Process
data FileInfo = FileInfo String String
files :: [FileInfo]
files :: [FileInfo]
files =
[ (String -> String -> FileInfo
FileInfo String
"~/.cabal/config" String
"The defaults that can be overridden with command-line options.")
]
manpageCmd :: String -> [CommandSpec a] -> ManpageFlags -> IO ()
manpageCmd :: 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.normal
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
pager <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"less" (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"
let pagerArgs :: [String]
pagerArgs = if String -> String
takeFileName String
pager String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"less" then [String
"-R"] else []
(Just Handle
inLess, Maybe Handle
_, Maybe Handle
_, ProcessHandle
procLess) <- Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> StdStream
-> StdStream
-> StdStream
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessWithEnv
Verbosity
Verbosity.normal
String
pager
[String]
pagerArgs
Maybe String
forall a. Maybe a
Nothing
Maybe [(String, String)]
forall a. Maybe a
Nothing
StdStream
Process.CreatePipe
StdStream
Process.Inherit
StdStream
Process.Inherit
Handle -> String -> IO ()
hPutStr Handle
inLess String
formatted
Handle -> IO ()
hClose Handle
inLess
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
procLess
where
contents :: String
contents :: String
contents = String -> [CommandSpec a] -> String
forall a. String -> [CommandSpec a] -> String
manpage String
pname [CommandSpec a]
commands
manpage :: String -> [CommandSpec a] -> String
manpage :: 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 :: 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 :: 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 t.
(t -> String)
-> (CommandUI flags -> Maybe (String -> t)) -> [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 t.
(t -> String)
-> (CommandUI flags -> Maybe (String -> t)) -> [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 :: (t -> String)
-> (CommandUI flags -> Maybe (String -> t)) -> [String]
optional t -> String
f CommandUI flags -> Maybe (String -> t)
field =
case CommandUI flags -> Maybe (String -> t)
field CommandUI flags
ui of
Just String -> t
text -> [ t -> String
f (t -> String) -> t -> String
forall a b. (a -> b) -> a -> b
$ String -> t
text String
pname, String
"" ]
Maybe (String -> t)
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 (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 (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 :: 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 :: 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 [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 (t :: * -> *) a. Foldable t => t a -> Bool
null String
optionChars Bool -> Bool -> Bool
&& [String] -> 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
""
]