help: allow substring matching

[ci skip]
This commit is contained in:
Simon Michael 2017-07-08 07:37:15 +01:00
parent 5e69d6de84
commit 9938aa5e79

View File

@ -6,6 +6,8 @@ The help command.
--TODO rename manuals --TODO rename manuals
--TODO substring matching --TODO substring matching
{-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Help ( module Hledger.Cli.Help (
helpmode helpmode
@ -15,8 +17,11 @@ module Hledger.Cli.Help (
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
import Data.Char
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.String.Here
import Safe
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import System.Environment import System.Environment
import System.IO import System.IO
@ -54,6 +59,9 @@ help' opts = do
interactive <- hIsTerminalDevice stdout interactive <- hIsTerminalDevice stdout
let let
args = take 1 $ listofstringopt "args" $ rawopts_ opts args = take 1 $ listofstringopt "args" $ rawopts_ opts
topic = case args of
[pat] -> headMay [t | t <- docTopics, map toLower pat `isInfixOf` t]
_ -> Nothing
[info, man, pager, cat] = [info, man, pager, cat] =
[runInfoForTopic, runManForTopic, runPagerForTopic pagerprog, printHelpForTopic] [runInfoForTopic, runManForTopic, runPagerForTopic pagerprog, printHelpForTopic]
viewer viewer
@ -66,7 +74,9 @@ help' opts = do
| "man" `elem` exes = man | "man" `elem` exes = man
| pagerprog `elem` exes = pager | pagerprog `elem` exes = pager
| otherwise = cat | otherwise = cat
case args of case topic of
[t] -> viewer t Nothing -> putStrLn $ [here|
_ -> putStrLn $ "Please choose a manual:\nhledger help " ++ intercalate "|" docTopics Please choose a manual by typing "hledger help MANUAL" (any substring is ok).
Manuals:
|] ++ " " ++ intercalate " " docTopics
Just t -> viewer t