{-|

The help command.

|-}
--TODO rename manuals
--TODO substring matching

{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Help (

   helpmode
  ,help'

  ) where

import Data.Maybe
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
import Safe (headMay)
--import Hledger.Utils.Debug

helpmode :: Mode RawOpts
helpmode = CommandHelpStr
-> [Flag RawOpts]
-> [(CommandHelpStr, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Help.txt")
  [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"i"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"info")  CommandHelpStr
"show the manual with info"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"m"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"man")   CommandHelpStr
"show the manual with man"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"p"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"pager") CommandHelpStr
"show the manual with $PAGER or less\n(less is always used if TOPIC is specified)"
  ]
  [(CommandHelpStr
helpflagstitle, [Flag RawOpts]
helpflags)]
  [
    [CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"debug"]    (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"debug" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"[N]" CommandHelpStr
"show debug output (levels 1-9, default: 1)"
  ]
  ([], 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
$ CommandHelpStr -> Arg RawOpts
argsFlag CommandHelpStr
"[TOPIC]")

-- | Display the hledger manual in various formats.
-- You can select a docs viewer with one of the `--info`, `--man`, `--pager` flags.
-- Otherwise it will use the first available of: info, man, $PAGER, less, stdout
-- (and always stdout if output is non-interactive).
help' :: CliOpts -> Journal -> IO ()
help' :: CliOpts -> Journal -> IO ()
help' CliOpts
opts Journal
_ = do
  [CommandHelpStr]
exes <- IO [CommandHelpStr]
likelyExecutablesInPath
  CommandHelpStr
pagerprog <- CommandHelpStr -> Maybe CommandHelpStr -> CommandHelpStr
forall a. a -> Maybe a -> a
fromMaybe CommandHelpStr
"less" (Maybe CommandHelpStr -> CommandHelpStr)
-> IO (Maybe CommandHelpStr) -> IO CommandHelpStr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandHelpStr -> IO (Maybe CommandHelpStr)
lookupEnv CommandHelpStr
"PAGER"
  Bool
interactive <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
  let
    args :: [CommandHelpStr]
args = Int -> [CommandHelpStr] -> [CommandHelpStr]
forall a. Int -> [a] -> [a]
take Int
1 ([CommandHelpStr] -> [CommandHelpStr])
-> [CommandHelpStr] -> [CommandHelpStr]
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> RawOpts -> [CommandHelpStr]
listofstringopt CommandHelpStr
"args" (RawOpts -> [CommandHelpStr]) -> RawOpts -> [CommandHelpStr]
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
    mtopic :: Maybe CommandHelpStr
mtopic = [CommandHelpStr] -> Maybe CommandHelpStr
forall a. [a] -> Maybe a
headMay [CommandHelpStr]
args
    [CommandHelpStr -> Maybe CommandHelpStr -> IO ()
info, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
man, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
pager, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
cat] =
      [CommandHelpStr -> Maybe CommandHelpStr -> IO ()
runInfoForTopic, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
runManForTopic, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
runPagerForTopic, CommandHelpStr -> Maybe CommandHelpStr -> IO ()
printHelpForTopic]
    viewer :: CommandHelpStr -> Maybe CommandHelpStr -> IO ()
viewer
      | CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"info"  (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
info
      | CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"man"   (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
man
      | CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"pager" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
pager
      | Bool -> Bool
not Bool
interactive                 = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
cat
      | CommandHelpStr
"info"    CommandHelpStr -> [CommandHelpStr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandHelpStr]
exes           = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
info
      | CommandHelpStr
"man"     CommandHelpStr -> [CommandHelpStr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandHelpStr]
exes           = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
man
      | CommandHelpStr
pagerprog CommandHelpStr -> [CommandHelpStr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandHelpStr]
exes           = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
pager
      | CommandHelpStr
"less"    CommandHelpStr -> [CommandHelpStr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandHelpStr]
exes           = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
pager
      | Bool
otherwise                       = CommandHelpStr -> Maybe CommandHelpStr -> IO ()
cat

  CommandHelpStr -> Maybe CommandHelpStr -> IO ()
viewer CommandHelpStr
"hledger" Maybe CommandHelpStr
mtopic