module Options.Applicative.Help (
cmdDesc,
briefDesc,
fullDesc,
parserHelpText,
) where
import Data.Lens.Common
import Data.List
import Data.Maybe
import Options.Applicative.Common
import Options.Applicative.Types
import Options.Applicative.Utils
showOption :: OptName -> String
showOption (OptLong n) = "--" ++ n
showOption (OptShort n) = '-' : [n]
data OptDescStyle = OptDescStyle
{ descSep :: String
, descHidden :: Bool
, descSurround :: Bool }
optDesc :: OptDescStyle -> Option r a -> String
optDesc style opt =
let ns = optionNames $ opt^.optMain
mv = opt^.optMetaVar
descs = map showOption (sort ns)
desc' = intercalate (descSep style) descs <+> mv
render text
| not (opt^.optShow) && not (descHidden style)
= ""
| null text || not (descSurround style)
= text
| isJust (opt^.optDefault)
= "[" ++ text ++ "]"
| null (drop 1 descs)
= text
| otherwise
= "(" ++ text ++ ")"
in render desc'
cmdDesc :: Parser a -> [String]
cmdDesc = concat . mapParser desc
where
desc opt
| CmdReader cmds p <- opt^.optMain
= tabulate [(cmd, d)
| cmd <- cmds
, d <- maybeToList . fmap (getL infoProgDesc) $ p cmd ]
| otherwise
= []
briefDesc :: Parser a -> String
briefDesc = foldr (<+>) "" . mapParser (optDesc style)
where
style = OptDescStyle
{ descSep = "|"
, descHidden = False
, descSurround = True }
fullDesc :: Parser a -> [String]
fullDesc = tabulate . catMaybes . mapParser doc
where
doc opt
| null n = Nothing
| null h = Nothing
| otherwise = Just (n, h)
where n = optDesc style opt
h = opt^.optHelp
style = OptDescStyle
{ descSep = ","
, descHidden = True
, descSurround = False }
parserHelpText :: ParserInfo a -> String
parserHelpText pinfo = unlines
$ nn [pinfo^.infoHeader]
++ [ " " ++ line | line <- nn [pinfo^.infoProgDesc] ]
++ [ line | let opts = fullDesc p
, not (null opts)
, line <- ["", "Common options:"] ++ opts
, pinfo^.infoFullDesc ]
++ [ line | let cmds = cmdDesc p
, not (null cmds)
, line <- ["", "Available commands:"] ++ cmds
, pinfo^.infoFullDesc ]
++ [ line | footer <- nn [pinfo^.infoFooter]
, line <- ["", footer] ]
where
nn = filter (not . null)
p = pinfo^.infoParser