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:
parent
3cd99e3f0b
commit
1de42395d4
2 changed files with 26 additions and 7 deletions
20
src/HCat.hs
20
src/HCat.hs
|
|
@ -4,20 +4,34 @@ module HCat (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Environment qualified as Env
|
import System.Environment qualified as Env
|
||||||
import System.IO (hPutStrLn, stderr)
|
import System.IO
|
||||||
|
|
||||||
import Control.Exception qualified as Exception
|
import Control.Exception qualified as Exception
|
||||||
import System.IO.Error qualified as IOError
|
import System.IO.Error qualified as IOError
|
||||||
|
|
||||||
import Data.Text.IO qualified as TextIO
|
import Data.Text.IO qualified as TextIO
|
||||||
|
|
||||||
import HCat.Internal (parseArgs)
|
import HCat.Internal
|
||||||
|
|
||||||
runHCat :: IO ()
|
runHCat :: IO ()
|
||||||
runHCat = do
|
runHCat = do
|
||||||
fileNameOrError <- parseArgs <$> Env.getArgs
|
fileNameOrError <- parseArgs <$> Env.getArgs
|
||||||
fileName <- eitherToError fileNameOrError
|
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 :: Show a => Either a b -> IO b
|
||||||
eitherToError = either (Exception.throwIO . IOError.userError . show) return
|
eitherToError = either (Exception.throwIO . IOError.userError . show) return
|
||||||
|
|
|
||||||
|
|
@ -76,13 +76,18 @@ getTerminalSize :: IO ScreenDimensions
|
||||||
getTerminalSize = case SysInfo.os of
|
getTerminalSize = case SysInfo.os of
|
||||||
"linux" -> tputScreenDimensions
|
"linux" -> tputScreenDimensions
|
||||||
"darwin" -> tputScreenDimensions
|
"darwin" -> tputScreenDimensions
|
||||||
_ -> pure $ defaultScreenDimensions{screenRows = 25, screenColumns = 80}
|
_ -> pure defaultScreenDimensions
|
||||||
|
|
||||||
defaultScreenDimensions :: ScreenDimensions
|
defaultScreenDimensions :: ScreenDimensions
|
||||||
defaultScreenDimensions = ScreenDimensions{screenRows = 25, screenColumns = 80}
|
defaultScreenDimensions =
|
||||||
|
ScreenDimensions
|
||||||
|
{ screenRows = 25
|
||||||
|
, screenColumns = 80
|
||||||
|
}
|
||||||
|
|
||||||
tputScreenDimensions :: IO ScreenDimensions
|
tputScreenDimensions :: IO ScreenDimensions
|
||||||
tputScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
|
tputScreenDimensions =
|
||||||
|
ScreenDimensions <$> tput "lines" <*> tput "cols"
|
||||||
where
|
where
|
||||||
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|
||||||
|
|
||||||
|
|
@ -94,6 +99,6 @@ getUserCommand = do
|
||||||
hSetEcho stdin False
|
hSetEcho stdin False
|
||||||
input <- getChar
|
input <- getChar
|
||||||
case input of
|
case input of
|
||||||
' ' -> pure NextPage
|
'n' -> pure NextPage
|
||||||
'q' -> pure Quit
|
'q' -> pure Quit
|
||||||
_ -> getUserCommand
|
_ -> getUserCommand
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue