Manpage.hs 6.8 KB
Newer Older
1
{-# LANGUAGE CPP #-}
Maciek Makowski's avatar
Maciek Makowski committed
2 3 4 5 6 7 8 9
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Manpage
-- Copyright   :  (c) Maciek Makowski 2015
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
10
-- Portability :  portable
Maciek Makowski's avatar
Maciek Makowski committed
11
--
12
-- Functions for building the manual page.
Maciek Makowski's avatar
Maciek Makowski committed
13 14

module Distribution.Client.Manpage
15 16
  ( -- * Manual page generation
    manpage
Oleg Grenrus's avatar
Oleg Grenrus committed
17 18 19 20
  , manpageCmd
  , ManpageFlags
  , defaultManpageFlags
  , manpageOptions
Maciek Makowski's avatar
Maciek Makowski committed
21 22
  ) where

Oleg Grenrus's avatar
Oleg Grenrus committed
23 24 25 26 27 28
import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.ManpageFlags
import Distribution.Client.Setup        (globalCommand)
import Distribution.Compat.Process      (createProcess)
Maciek Makowski's avatar
Maciek Makowski committed
29
import Distribution.Simple.Command
Oleg Grenrus's avatar
Oleg Grenrus committed
30 31
import Distribution.Simple.Flag         (fromFlagOrDefault)
import System.IO                        (hClose, hPutStr)
Maciek Makowski's avatar
Maciek Makowski committed
32

Oleg Grenrus's avatar
Oleg Grenrus committed
33
import qualified System.Process as Process
Maciek Makowski's avatar
Maciek Makowski committed
34 35 36

data FileInfo = FileInfo String String -- ^ path, description

Oleg Grenrus's avatar
Oleg Grenrus committed
37 38 39 40
-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------

Maciek Makowski's avatar
Maciek Makowski committed
41 42 43 44 45 46 47
-- | A list of files that should be documented in the manual page.
files :: [FileInfo]
files =
  [ (FileInfo "~/.cabal/config" "The defaults that can be overridden with command-line options.")
  , (FileInfo "~/.cabal/world"  "A list of all packages whose installation has been explicitly requested.")
  ]

Oleg Grenrus's avatar
Oleg Grenrus committed
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
manpageCmd :: String -> [CommandSpec a] -> ManpageFlags -> IO ()
manpageCmd pname commands flags
    | fromFlagOrDefault False (manpageRaw flags)
    = putStrLn contents
    | otherwise
    = do
        let cmd  = "man"
            args = ["-l", "-"]

        (mb_in, _, _, ph) <- createProcess (Process.proc cmd args)
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.Inherit
            , Process.std_err = Process.Inherit
            }

        -- put contents
        for_ mb_in $ \hin -> do
            hPutStr hin contents
            hClose hin

        -- wait for process to exit, propagate exit code
        ec <- Process.waitForProcess ph
        exitWith ec
  where
    contents :: String
    contents = manpage pname commands

Maciek Makowski's avatar
Maciek Makowski committed
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
-- | Produces a manual page with @troff@ markup.
manpage :: String -> [CommandSpec a] -> String
manpage pname commands = unlines $
  [ ".TH " ++ map toUpper pname ++ " 1"
  , ".SH NAME"
  , pname ++ " \\- a system for building and packaging Haskell libraries and programs"
  , ".SH SYNOPSIS"
  , ".B " ++ pname
  , ".I command"
  , ".RI < arguments |[ options ]>..."
  , ""
  , "Where the"
  , ".I commands"
  , "are"
  , ""
  ] ++
  concatMap (commandSynopsisLines pname) commands ++
  [ ".SH DESCRIPTION"
93
  , "Cabal is the standard package system for Haskell software. It helps people to configure, "
Maciek Makowski's avatar
Maciek Makowski committed
94 95 96 97 98 99
  , "build and install Haskell software and to distribute it easily to other users and developers."
  , ""
  , "The command line " ++ pname ++ " tool (also referred to as cabal-install) helps with "
  , "installing existing packages and developing new packages. "
  , "It can be used to work with local packages or to install packages from online package archives, "
  , "including automatically installing dependencies. By default it is configured to use Hackage, "
100
  , "which is Haskell's central package archive that contains thousands of libraries and applications "
Maciek Makowski's avatar
Maciek Makowski committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
  , "in the Cabal package format."
  , ".SH OPTIONS"
  , "Global options:"
  , ""
  ] ++
  optionsLines (globalCommand []) ++
  [ ".SH COMMANDS"
  ] ++
  concatMap (commandDetailsLines pname) commands ++
  [ ".SH FILES"
  ] ++
  concatMap fileLines files ++
  [ ".SH BUGS"
  , "To browse the list of known issues or report a new one please see "
  , "https://github.com/haskell/cabal/labels/cabal-install."
  ]

commandSynopsisLines :: String -> CommandSpec action -> [String]
119
commandSynopsisLines pname (CommandSpec ui _ NormalCommand) =
Maciek Makowski's avatar
Maciek Makowski committed
120 121 122 123
  [ ".B " ++ pname ++ " " ++ (commandName ui)
  , ".R - " ++ commandSynopsis ui
  , ".br"
  ]
124
commandSynopsisLines _ (CommandSpec _ _ HiddenCommand) = []
Maciek Makowski's avatar
Maciek Makowski committed
125 126

commandDetailsLines :: String -> CommandSpec action -> [String]
127
commandDetailsLines pname (CommandSpec ui _ NormalCommand) =
128
  [ ".B " ++ pname ++ " " ++ (commandName ui)
Maciek Makowski's avatar
Maciek Makowski committed
129 130 131 132 133 134 135 136 137 138 139
  , ""
  , commandUsage ui pname
  , ""
  ] ++
  optional commandDescription ++
  optional commandNotes ++
  [ "Flags:"
  , ".RS"
  ] ++
  optionsLines ui ++
  [ ".RE"
140
  , ""
Maciek Makowski's avatar
Maciek Makowski committed
141 142 143 144 145 146
  ]
  where
    optional field =
      case field ui of
        Just text -> [text pname, ""]
        Nothing   -> []
147
commandDetailsLines _ (CommandSpec _ _ HiddenCommand) = []
Maciek Makowski's avatar
Maciek Makowski committed
148 149 150 151 152

optionsLines :: CommandUI flags -> [String]
optionsLines command = concatMap optionLines (concatMap optionDescr (commandOptions command ParseArgs))

data ArgumentRequired = Optional | Required
153
type OptionArg = (ArgumentRequired, ArgPlaceHolder)
Maciek Makowski's avatar
Maciek Makowski committed
154 155

optionLines :: OptDescr flags -> [String]
156
optionLines (ReqArg description (optionChars, optionStrings) placeHolder _ _) =
Maciek Makowski's avatar
Maciek Makowski committed
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
  argOptionLines description optionChars optionStrings (Required, placeHolder)
optionLines (OptArg description (optionChars, optionStrings) placeHolder _ _ _) =
  argOptionLines description optionChars optionStrings (Optional, placeHolder)
optionLines (BoolOpt description (trueChars, trueStrings) (falseChars, falseStrings) _ _) =
  optionLinesIfPresent trueChars trueStrings ++
  optionLinesIfPresent falseChars falseStrings ++
  optionDescriptionLines description
optionLines (ChoiceOpt options) =
  concatMap choiceLines options
  where
    choiceLines (description, (optionChars, optionStrings), _, _) =
      [ optionsLine optionChars optionStrings ] ++
      optionDescriptionLines description

argOptionLines :: String -> [Char] -> [String] -> OptionArg -> [String]
argOptionLines description optionChars optionStrings arg =
  [ optionsLine optionChars optionStrings
  , optionArgLine arg
  ] ++
  optionDescriptionLines description

optionLinesIfPresent :: [Char] -> [String] -> [String]
optionLinesIfPresent optionChars optionStrings =
  if null optionChars && null optionStrings then []
  else                                           [ optionsLine optionChars optionStrings, ".br" ]

optionDescriptionLines :: String -> [String]
optionDescriptionLines description =
  [ ".RS"
  , description
  , ".RE"
  , ""
  ]

optionsLine :: [Char] -> [String] -> String
optionsLine optionChars optionStrings =
  intercalate ", " (shortOptions optionChars ++ longOptions optionStrings)

shortOptions :: [Char] -> [String]
shortOptions = map (\c -> "\\-" ++ [c])

longOptions :: [String] -> [String]
longOptions = map (\s -> "\\-\\-" ++ s)

optionArgLine :: OptionArg -> String
optionArgLine (Required, placeHolder) = ".I " ++ placeHolder
optionArgLine (Optional, placeHolder) = ".RI [ " ++ placeHolder ++ " ]"

fileLines :: FileInfo -> [String]
fileLines (FileInfo path description) =
  [ path
  , ".RS"
  , description
  , ".RE"
  , ""
  ]