slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: lib: avoid using pager on Windows, part 2

Browse Source
This commit is contained in:
Simon Michael 2023-03-10 20:55:44 -10:00
parent b83eb136cc
commit 6dc91588e4
1 changed files with 9 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
hledger-lib/Hledger/Utils/IO.hs
View File

@ -66,7 +66,7 @@ import Data.Colour.RGBSpace.HSL (lightness)
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, pack) import qualified Data.Text as T
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
@ -85,7 +85,7 @@ import System.IO
openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom, hIsTerminalDevice) openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom, hIsTerminalDevice)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import System.Pager import System.Pager (printOrPage)
#endif #endif
import Text.Pretty.Simple import Text.Pretty.Simple
(CheckColorTty(CheckColorTty), OutputOptions(..), (CheckColorTty(CheckColorTty), OutputOptions(..),
@ -130,14 +130,13 @@ pprint' = pPrintOpt CheckColorTty prettyopts'
-- | Display the given text on the terminal, using the user's $PAGER if the text is taller -- | 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 and TERM is not "dumb". -- than the current terminal and stdout is interactive and TERM is not "dumb".
pager :: String -> IO () pager :: String -> IO ()
#ifdef mingw32_HOST_OS
pager = putStrLn
#else
pager s = do pager s = do
dumbterm <- (== Just "dumb") <$> lookupEnv "TERM" dumbterm <- (== Just "dumb") <$> lookupEnv "TERM"
#ifdef mingw32_HOST_OS (if dumbterm then putStrLn else printOrPage . T.pack) s
putStrLn
#else
(if dumbterm then putStrLn else printOrPage . pack)
#endif #endif
s
-- Command line arguments -- Command line arguments
@ -317,18 +316,18 @@ expandHomePath = \case
-- converting any \r\n line endings to \n,, -- converting any \r\n line endings to \n,,
-- using the system locale's text encoding, -- using the system locale's text encoding,
-- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. -- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8.
readFilePortably :: FilePath -> IO Text readFilePortably :: FilePath -> IO T.Text
readFilePortably f = openFile f ReadMode >>= readHandlePortably readFilePortably f = openFile f ReadMode >>= readHandlePortably
-- | Like readFilePortably, but read from standard input if the path is "-". -- | Like readFilePortably, but read from standard input if the path is "-".
readFileOrStdinPortably :: String -> IO Text readFileOrStdinPortably :: String -> IO T.Text
readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably
where where
openFileOrStdin :: String -> IOMode -> IO Handle openFileOrStdin :: String -> IOMode -> IO Handle
openFileOrStdin "-" _ = return stdin openFileOrStdin "-" _ = return stdin
openFileOrStdin f' m = openFile f' m openFileOrStdin f' m = openFile f' m
readHandlePortably :: Handle -> IO Text readHandlePortably :: Handle -> IO T.Text
readHandlePortably h = do readHandlePortably h = do
hSetNewlineMode h universalNewlineMode hSetNewlineMode h universalNewlineMode
menc <- hGetEncoding h menc <- hGetEncoding h