imp: cli: use $PAGER when help output is taller than terminal
This works with hledger, hledger -h and hledger CMD -h.
This commit is contained in:
parent
093fdda7db
commit
d77d76e17f
@ -19,6 +19,9 @@ module Hledger.Utils.IO (
|
|||||||
pprint,
|
pprint,
|
||||||
pprint',
|
pprint',
|
||||||
|
|
||||||
|
-- * Viewing with pager
|
||||||
|
pager,
|
||||||
|
|
||||||
-- * Command line arguments
|
-- * Command line arguments
|
||||||
progArgs,
|
progArgs,
|
||||||
outputFileOption,
|
outputFileOption,
|
||||||
@ -57,7 +60,7 @@ import Control.Monad (when)
|
|||||||
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
||||||
import Data.List hiding (uncons)
|
import Data.List hiding (uncons)
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text, pack)
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import qualified Data.Text.Lazy.Builder as TB
|
import qualified Data.Text.Lazy.Builder as TB
|
||||||
@ -74,6 +77,7 @@ import System.IO
|
|||||||
(Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
|
(Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
|
||||||
openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom)
|
openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom)
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
import System.Pager
|
||||||
import Text.Pretty.Simple
|
import Text.Pretty.Simple
|
||||||
(CheckColorTty(CheckColorTty), OutputOptions(..),
|
(CheckColorTty(CheckColorTty), OutputOptions(..),
|
||||||
defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)
|
defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)
|
||||||
@ -114,6 +118,11 @@ pprint' = pPrintOpt CheckColorTty prettyopts'
|
|||||||
|
|
||||||
-- "Avoid using pshow, pprint, dbg* in the code below to prevent infinite loops." (?)
|
-- "Avoid using pshow, pprint, dbg* in the code below to prevent infinite loops." (?)
|
||||||
|
|
||||||
|
-- | Display the given text on the terminal, using the user's $PAGER if the text is taller
|
||||||
|
-- than the current terminal and stdout is interactive.
|
||||||
|
pager :: String -> IO ()
|
||||||
|
pager s = printOrPage $ pack s
|
||||||
|
|
||||||
-- Command line arguments
|
-- Command line arguments
|
||||||
|
|
||||||
-- | The command line arguments that were used at program startup.
|
-- | The command line arguments that were used at program startup.
|
||||||
|
|||||||
@ -58,6 +58,7 @@ dependencies:
|
|||||||
- microlens >=0.4
|
- microlens >=0.4
|
||||||
- microlens-th >=0.4
|
- microlens-th >=0.4
|
||||||
- mtl >=2.2.1
|
- mtl >=2.2.1
|
||||||
|
- pager >=0.1.1.0
|
||||||
- parser-combinators >=0.4.0
|
- parser-combinators >=0.4.0
|
||||||
- pretty-simple >4 && <5
|
- pretty-simple >4 && <5
|
||||||
- regex-tdfa
|
- regex-tdfa
|
||||||
|
|||||||
@ -289,7 +289,7 @@ knownCommands = sort . commandsFromCommandsList . drop 1 $ commandsList progname
|
|||||||
-- extra addons will be added under Misc.
|
-- extra addons will be added under Misc.
|
||||||
printCommandsList :: String -> [String] -> IO ()
|
printCommandsList :: String -> [String] -> IO ()
|
||||||
printCommandsList progversion addonsFound =
|
printCommandsList progversion addonsFound =
|
||||||
putStr . unlines . concatMap adjustline $
|
pager . unlines . concatMap adjustline $
|
||||||
commandsList progversion (map ('+':) unknownCommandsFound)
|
commandsList progversion (map ('+':) unknownCommandsFound)
|
||||||
where
|
where
|
||||||
commandsFound = map (' ':) builtinCommandNames ++ map ('+':) addonsFound
|
commandsFound = map (' ':) builtinCommandNames ++ map ('+':) addonsFound
|
||||||
|
|||||||
@ -140,13 +140,13 @@ main = do
|
|||||||
isExternalCommand = not (null cmd) && cmd `elem` addons -- probably
|
isExternalCommand = not (null cmd) && cmd `elem` addons -- probably
|
||||||
isBadCommand = not (null rawcmd) && null cmd
|
isBadCommand = not (null rawcmd) && null cmd
|
||||||
hasVersion = ("--version" `elem`)
|
hasVersion = ("--version" `elem`)
|
||||||
printUsage = putStr $ showModeUsage $ mainmode addons
|
printUsage = pager $ showModeUsage $ mainmode addons
|
||||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
||||||
hasHelpFlag args1 = any (`elem` args1) ["-h","--help"]
|
hasHelpFlag args1 = any (`elem` args1) ["-h","--help"]
|
||||||
hasManFlag args1 = (`elem` args1) "--man"
|
hasManFlag args1 = (`elem` args1) "--man"
|
||||||
hasInfoFlag args1 = (`elem` args1) "--info"
|
hasInfoFlag args1 = (`elem` args1) "--info"
|
||||||
f `orShowHelp` mode1
|
f `orShowHelp` mode1
|
||||||
| hasHelpFlag args = putStr $ showModeUsage mode1
|
| hasHelpFlag args = pager $ showModeUsage mode1
|
||||||
| hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode1)
|
| hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode1)
|
||||||
| hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode1)
|
| hasManFlag args = runManForTopic "hledger" (headMay $ modeNames mode1)
|
||||||
| otherwise = f
|
| otherwise = f
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user