{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Help (
helpmode
,help'
) where
import Prelude ()
import "base-compat-batteries" Prelude.Compat
import Data.Char
import Data.List
import Data.Maybe
import Safe
import System.Console.CmdArgs.Explicit
import System.Environment
import System.IO
import Hledger.Utils (embedFileRelative)
import Hledger.Data.RawOptions
import Hledger.Data.Types
import Hledger.Cli.CliOptions
import Hledger.Cli.DocFiles
helpmode :: Mode RawOpts
helpmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Help.txt")
[[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"info"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"info") CommandDoc
"show the manual with info"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"man"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"man") CommandDoc
"show the manual with man"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"pager"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"pager") CommandDoc
"show the manual with $PAGER or less"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"cat"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"cat") CommandDoc
"show the manual on stdout"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"help",CommandDoc
"h"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"help") CommandDoc
"show this help"
]
[]
[]
([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[MANUAL]")
help' :: CliOpts -> Journal -> IO ()
help' :: CliOpts -> Journal -> IO ()
help' CliOpts
opts Journal
_ = do
[CommandDoc]
exes <- IO [CommandDoc]
likelyExecutablesInPath
CommandDoc
pagerprog <- CommandDoc -> Maybe CommandDoc -> CommandDoc
forall a. a -> Maybe a -> a
fromMaybe CommandDoc
"less" (Maybe CommandDoc -> CommandDoc)
-> IO (Maybe CommandDoc) -> IO CommandDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandDoc -> IO (Maybe CommandDoc)
lookupEnv CommandDoc
"PAGER"
Bool
interactive <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
let
args :: [CommandDoc]
args = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
take Int
1 ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" (RawOpts -> [CommandDoc]) -> RawOpts -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
topic :: Maybe CommandDoc
topic = case [CommandDoc]
args of
[CommandDoc
pat] -> [CommandDoc] -> Maybe CommandDoc
forall a. [a] -> Maybe a
headMay [CommandDoc
t | CommandDoc
t <- [CommandDoc]
docTopics, (Char -> Char) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower CommandDoc
pat CommandDoc -> CommandDoc -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` CommandDoc
t]
[CommandDoc]
_ -> Maybe CommandDoc
forall a. Maybe a
Nothing
[CommandDoc -> IO ()
info, CommandDoc -> IO ()
man, CommandDoc -> IO ()
pager, CommandDoc -> IO ()
cat] =
[CommandDoc -> IO ()
runInfoForTopic, CommandDoc -> IO ()
runManForTopic, CommandDoc -> CommandDoc -> IO ()
runPagerForTopic CommandDoc
pagerprog, CommandDoc -> IO ()
printHelpForTopic]
viewer :: CommandDoc -> IO ()
viewer
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"info" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandDoc -> IO ()
info
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"man" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandDoc -> IO ()
man
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"pager" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandDoc -> IO ()
pager
| CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"cat" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandDoc -> IO ()
cat
| Bool -> Bool
not Bool
interactive = CommandDoc -> IO ()
cat
| CommandDoc
"info" CommandDoc -> [CommandDoc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandDoc]
exes = CommandDoc -> IO ()
info
| CommandDoc
"man" CommandDoc -> [CommandDoc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandDoc]
exes = CommandDoc -> IO ()
man
| CommandDoc
pagerprog CommandDoc -> [CommandDoc] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandDoc]
exes = CommandDoc -> IO ()
pager
| Bool
otherwise = CommandDoc -> IO ()
cat
case Maybe CommandDoc
topic of
Maybe CommandDoc
Nothing -> CommandDoc -> IO ()
putStrLn (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> CommandDoc
unlines [
CommandDoc
"Please choose a manual by typing \"hledger help MANUAL\" (any substring is ok)."
,CommandDoc
"A viewer (info, man, a pager, or stdout) will be auto-selected,"
,CommandDoc
"or type \"hledger help -h\" to see options. Manuals available:"
]
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
"\n " CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ [CommandDoc] -> CommandDoc
unwords [CommandDoc]
docTopics
Just CommandDoc
t -> CommandDoc -> IO ()
viewer CommandDoc
t