Implement basic hcat functionality

We show a simple UI that informs the user about the possible choices:

- n to show the next page
- q to quit immediately
This commit is contained in:
Alexander Kobjolke 2023-08-30 19:46:40 +02:00
parent 3cd99e3f0b
commit 1de42395d4
2 changed files with 26 additions and 7 deletions

View file

@ -4,20 +4,34 @@ module HCat (
) where
import System.Environment qualified as Env
import System.IO (hPutStrLn, stderr)
import System.IO
import Control.Exception qualified as Exception
import System.IO.Error qualified as IOError
import Data.Text.IO qualified as TextIO
import HCat.Internal (parseArgs)
import HCat.Internal
runHCat :: IO ()
runHCat = do
fileNameOrError <- parseArgs <$> Env.getArgs
fileName <- eitherToError fileNameOrError
TextIO.readFile fileName >>= TextIO.putStr
content <- TextIO.readFile fileName
screen <- getTerminalSize
let contentPane = screen{screenRows = screenRows screen - 1}
showPages $ paginate contentPane content
showPages :: Pages -> IO ()
showPages [] = pure ()
showPages (p : ps) = do
TextIO.putStr p
putStr ">>> (n)ext page or (q)uit?"
hFlush stdout
cmd <- getUserCommand
case cmd of
Quit -> pure ()
NextPage -> putStrLn "" >> showPages ps
eitherToError :: Show a => Either a b -> IO b
eitherToError = either (Exception.throwIO . IOError.userError . show) return

View file

@ -76,13 +76,18 @@ getTerminalSize :: IO ScreenDimensions
getTerminalSize = case SysInfo.os of
"linux" -> tputScreenDimensions
"darwin" -> tputScreenDimensions
_ -> pure $ defaultScreenDimensions{screenRows = 25, screenColumns = 80}
_ -> pure defaultScreenDimensions
defaultScreenDimensions :: ScreenDimensions
defaultScreenDimensions = ScreenDimensions{screenRows = 25, screenColumns = 80}
defaultScreenDimensions =
ScreenDimensions
{ screenRows = 25
, screenColumns = 80
}
tputScreenDimensions :: IO ScreenDimensions
tputScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
tputScreenDimensions =
ScreenDimensions <$> tput "lines" <*> tput "cols"
where
tput cmd = read <$> P.readProcess "tput" [cmd] ""
@ -94,6 +99,6 @@ getUserCommand = do
hSetEcho stdin False
input <- getChar
case input of
' ' -> pure NextPage
'n' -> pure NextPage
'q' -> pure Quit
_ -> getUserCommand