Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
169 additions
and
167 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,166 @@ | ||
| module UI.Command.Doc ( | ||
| help, man | ||
| )where | ||
|
|
||
| import Data.Default | ||
| import Data.Char (toUpper) | ||
|
|
||
| import System.Locale (defaultTimeLocale) | ||
| import Data.Time.Format (formatTime) | ||
| import Data.Time.Clock (getCurrentTime) | ||
|
|
||
| import Text.Printf (printf) | ||
|
|
||
| import UI.Command.Command | ||
| import UI.Command.Render | ||
|
|
||
| ------------------------------------------------------------ | ||
| -- internal subcommands | ||
| -- | ||
|
|
||
| internalSubs = [helpSub, manSub] | ||
|
|
||
| ------------------------------------------------------------ | ||
| -- Help | ||
| -- | ||
|
|
||
| helpSub :: SubCommand | ||
| helpSub = def {subName = "help", subShortDesc = "Display help for a specific subcommand"} | ||
|
|
||
| help :: Command -> [String] -> IO () | ||
| help cmd args = mapM_ putStr $ longHelp cmd args | ||
|
|
||
| longHelp :: Command -> [String] -> [String] | ||
| -- | "cmd help" with no arguments: Give a list of all subcommands | ||
| longHelp cmd [] = | ||
| [commandShortDesc cmd ++ "\n"] ++ | ||
| ["Usage: " ++ (commandName cmd) ++ " [--version] [--help] command [args]\n\n"] ++ | ||
| [indent 2 (commandLongDesc cmd), "\n"] ++ | ||
| map (categoryHelp cmd) (commandCategories cmd) ++ | ||
| [internalHelp cmd] ++ | ||
| ["\nPlease report bugs to <" ++ commandBugEmail cmd ++ ">\n"] | ||
|
|
||
| -- | "cmd help command": Give command-specific help | ||
| longHelp cmd (command:_) = contextHelp cmd command m | ||
| where m = filter (\x -> subName x == command) (commandSubs cmd) | ||
|
|
||
| -- | Provide synopses for a specific category of commands | ||
| categoryHelp :: Command -> String -> String | ||
| categoryHelp cmd c = c ++ ":\n" ++ unlines (map itemHelp items) ++ "\n" | ||
| where | ||
| items = filter (\x -> subCategory x == c) (commandSubs cmd) | ||
|
|
||
| -- | Provide synopses for internal commands | ||
| internalHelp :: Command -> String | ||
| internalHelp cmd = unlines $ "Miscellaneous:" : map itemHelp internalSubs | ||
|
|
||
| -- | One-line format for a command | ||
| itemHelp i = printf " %-14s%s" (subName i) (subShortDesc i) | ||
|
|
||
| -- | Provide detailed help for a specific command | ||
| contextHelp :: Command -> [Char] -> [SubCommand] -> [String] | ||
| contextHelp cmd command [] = longHelp cmd [] ++ contextError | ||
| where contextError = ["\n*** \"" ++ command ++ "\": Unknown command.\n"] | ||
| contextHelp cmd command (item:_) = synopsis ++ usage ++ description ++ examples | ||
| where usage = ["Usage: " ++ commandName cmd ++ " " ++ command ++ hasOpts command ++ "\n"] | ||
| hasOpts "help" = " command" | ||
| hasOpts _ = " [options]" | ||
| synopsis = [(commandName cmd) ++ " " ++ command ++ ": " ++ subSynopsis item ++ "\n"] | ||
| description = case (subShortDesc item) of | ||
| "" -> [] | ||
| _ -> ["\n" ++ indent 2 (subShortDesc item)] | ||
| examples = case (subExamples item) of | ||
| [] -> [] | ||
| _ -> ["\nExamples:"] ++ | ||
| flip map (subExamples item) (\(desc,opts) -> | ||
| "\n " ++ desc ++ ":\n " ++ (commandName cmd) ++ " " ++ command ++ | ||
| " " ++ opts ++ "\n") | ||
|
|
||
| ------------------------------------------------------------ | ||
| -- man | ||
| -- | ||
|
|
||
| manSub :: SubCommand | ||
| manSub = def {subName = "man", subShortDesc = "Generate Unix man page for specific subcommand"} | ||
|
|
||
| man :: Command -> [String] -> IO () | ||
| man cmd args = do | ||
| currentTime <- getCurrentTime | ||
| let dateStamp = formatTime defaultTimeLocale "%B %Y" currentTime | ||
| mapM_ putStrLn $ longMan cmd dateStamp args | ||
|
|
||
| headerMan :: Command -> String -> [String] | ||
| headerMan cmd dateStamp = [unwords [".TH", u, "1", quote dateStamp, quote "Flim!", "\n"]] | ||
| where | ||
| u = map toUpper (commandName cmd) | ||
|
|
||
| synopsisMan :: Command -> String -> [SubCommand] -> [String] | ||
| synopsisMan cmd _ [] = | ||
| [".SH SYNOPSIS\n\n.B ", commandName cmd, "\n.RI SUBCOMMAND\n[\n.I OPTIONS\n]\n.I filename ...\n\n"] | ||
| synopsisMan cmd command (item:_) = | ||
| [".SH SYNOPSIS\n\n.B ", commandName cmd, "\n.RI ", command, "\n", hasOpts command, "\n"] | ||
| where hasOpts "help" = ".I <subcommand>\n" | ||
| hasOpts "man" = ".I <subcommand>\n" | ||
| hasOpts _ = "[\n.I OPTIONS\n]\n" | ||
|
|
||
| authorsMan :: Command -> String -> [String] | ||
| authorsMan cmd command = a ++ g ++ e | ||
| where | ||
| n = commandName cmd | ||
| a | commandAuthors cmd == [] = [] | ||
| | otherwise = [".SH AUTHORS\n\n" ++ n ++ " was written by ", englishList $ commandAuthors cmd, "\n\n"] | ||
| g = ["This manual page was autogenerated by\n.B " ++ n ++ " man" ++ space command ++ ".\n\n"] | ||
| e | commandBugEmail cmd == "" = [] | ||
| | otherwise = ["Please report bugs to <" ++ commandBugEmail cmd ++ ">\n"] | ||
| space "" = "" | ||
| space c = ' ':c | ||
|
|
||
| descMan :: String -> [String] | ||
| descMan desc = [".SH DESCRIPTION\n", desc, "\n"] | ||
|
|
||
| longMan :: Command -> String -> [String] -> [String] | ||
| longMan cmd dateStamp [] = | ||
| headerMan cmd dateStamp ++ | ||
| [".SH NAME"] ++ | ||
| [commandName cmd, " \\- ", commandShortDesc cmd, "\n\n"] ++ | ||
| synopsisMan cmd "SUBCOMMAND" [] ++ | ||
| descMan (".B " ++ commandName cmd ++ "\n" ++ commandLongDesc cmd) ++ | ||
| map (categoryMan cmd) (commandCategories cmd) ++ | ||
| authorsMan cmd "" ++ | ||
| seeAlsoMan cmd | ||
|
|
||
| longMan cmd dateStamp (command:_) = contextMan cmd dateStamp command m | ||
| where | ||
| m = filter (\x -> subName x == command) (commandSubs cmd) | ||
|
|
||
| -- | Provide a list of related commands | ||
| seeAlsoMan :: Command -> [String] | ||
| seeAlsoMan cmd | ||
| | commandSeeAlso cmd == def = [] | ||
| | otherwise = [".SH \"SEE ALSO\"\n\n.PP\n"] ++ | ||
| map (\x -> "\\fB"++x++"\\fR(1)\n") (commandSeeAlso cmd) | ||
|
|
||
| -- | Provide synopses for a specific category of commands | ||
| categoryMan :: Command -> String -> String | ||
| categoryMan cmd c = ".SH " ++ (map toUpper c) ++ "\n" ++ concat (map itemMan items) ++ "\n" | ||
| where items = filter (\x -> subCategory x == c) (commandSubs cmd) | ||
| itemMan i = printf ".IP %s\n%s\n" (subName i) (subShortDesc i) | ||
|
|
||
| contextMan :: Command -> String -> [Char] -> [SubCommand] -> [String] | ||
| contextMan cmd dateStamp _ [] = longMan cmd dateStamp [] | ||
| contextMan cmd dateStamp command i@(item:_) = | ||
| headerMan cmd dateStamp ++ | ||
| synopsisMan cmd command i ++ | ||
| descMan (subSynopsis item) ++ | ||
| description ++ | ||
| examples ++ | ||
| authorsMan cmd command | ||
| where | ||
| description | subShortDesc item == "" = [] | ||
| | otherwise = ["\n" ++ subShortDesc item] | ||
| examples | subExamples item == [] = [] | ||
| | otherwise = ["\n.SH ExAMPLES\n"] ++ | ||
| flip map (subExamples item) (\(desc, opts) -> | ||
| ".PP\n" ++ desc ++ ":\n.PP\n.RS\n\\f(CW" ++ | ||
| commandName cmd ++ " " ++ command ++ " " ++ | ||
| opts ++ "\\fP\n.RE\n") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters