Implement a status line

The status line shows information about the shown file, such as size,
modification time and permissions.
This commit is contained in:
Alexander Kobjolke 2023-09-08 22:04:25 +02:00
parent 2ecde4fea5
commit 10057518cb
7 changed files with 82 additions and 14 deletions

View file

@ -20,6 +20,8 @@ library
HCat HCat
HCat.FileInfo HCat.FileInfo
HCat.Internal HCat.Internal
HCat.Screen
HCat.StatusLine
other-modules: other-modules:
Paths_hcat Paths_hcat
hs-source-dirs: hs-source-dirs:

View file

@ -1,3 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
module HCat ( module HCat (
runHCat, runHCat,
defaultMain, defaultMain,
@ -9,29 +11,44 @@ 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 (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as TextIO import Data.Text.IO qualified as TextIO
import HCat.FileInfo (getFileInfo)
import HCat.Internal import HCat.Internal
import HCat.Screen
import HCat.StatusLine
runHCat :: IO () runHCat :: IO ()
runHCat = do runHCat = do
fileNameOrError <- parseArgs <$> Env.getArgs fileNameOrError <- parseArgs <$> Env.getArgs
fileName <- eitherToError fileNameOrError fileName <- eitherToError fileNameOrError
content <- TextIO.readFile fileName content <- TextIO.readFile fileName
fileInfo <- getFileInfo fileName
screen <- getTerminalSize screen <- getTerminalSize
let contentPane = screen{screenRows = screenRows screen - 1} let contentPane = screen{screenRows = screenRows screen - 1}
showPages $ paginate contentPane content statusLine = StatusLine fileInfo 1 $ length pages
pages = paginate contentPane content
showPages (screenColumns screen) statusLine pages
showPages :: Pages -> IO () showPages :: Int -> StatusLine -> Pages -> IO ()
showPages [] = pure () showPages _ _ [] = pure ()
showPages (p : ps) = do showPages maxWidth statusLine@StatusLine{..} (p : ps) = do
TextIO.putStr p TextIO.putStr p
putStr ">>> (n)ext page or (q)uit?" let s = snippet maxWidth $ formatStatusLine statusLine
TextIO.putStr s
hFlush stdout hFlush stdout
cmd <- getUserCommand cmd <- getUserCommand
case cmd of case cmd of
Quit -> pure () Quit -> pure ()
NextPage -> putStrLn "" >> showPages ps NextPage -> putStrLn "" >> showPages maxWidth statusLine{currentPage = currentPage + 1} ps
snippet :: Int -> Text -> Text
snippet n text
| n <= 3 = ""
| n <= Text.length text = Text.take (n - 3) text <> "..."
| otherwise = text
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

View file

@ -2,7 +2,7 @@
-- | FileInfo defines a data type that captures important information about a -- | FileInfo defines a data type that captures important information about a
-- file such as timestamps and permissions. -- file such as timestamps and permissions.
module HCat.FileInfo (FileInfo, getFileInfo) where module HCat.FileInfo where
import Data.Text (Text) import Data.Text (Text)
import Data.Text qualified as T import Data.Text qualified as T
@ -42,4 +42,4 @@ getFileInfo path = do
fileWritable = Directory.writable perms fileWritable = Directory.writable perms
fileExecutable = Directory.executable perms fileExecutable = Directory.executable perms
filePath = T.pack path filePath = T.pack path
return FileInfo{..} pure FileInfo{..}

View file

@ -8,6 +8,8 @@ import System.IO
import System.Info qualified as SysInfo import System.Info qualified as SysInfo
import System.Process qualified as P import System.Process qualified as P
import HCat.Screen
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element. -- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
-- --
-- >>> parseArgs ["foo"] -- >>> parseArgs ["foo"]
@ -54,12 +56,6 @@ wordWrap n text
in line : wordWrap n rest in line : wordWrap n rest
| otherwise = pure text | otherwise = pure text
data ScreenDimensions = ScreenDimensions
{ screenRows :: Int
, screenColumns :: Int
}
deriving (Show)
-- | @paginate@ transforms a given piece of Text into pages of lines that fit -- | @paginate@ transforms a given piece of Text into pages of lines that fit
-- onto the screen. -- onto the screen.
-- --

8
src/HCat/Screen.hs Normal file
View file

@ -0,0 +1,8 @@
-- | Types and functions related to the screen
module HCat.Screen where
data ScreenDimensions = ScreenDimensions
{ screenRows :: Int
, screenColumns :: Int
}
deriving (Show)

44
src/HCat/StatusLine.hs Normal file
View file

@ -0,0 +1,44 @@
{-# LANGUAGE RecordWildCards #-}
-- | This module contains a data type that represents all information we'd like
-- to show in a statusline.
module HCat.StatusLine where
import HCat.FileInfo
import Data.Bool (bool)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time qualified as TimeFormat
import Text.Printf
data StatusLine = StatusLine
{ fileInfo :: FileInfo
, currentPage :: Int
, maximumPage :: Int
}
deriving (Show)
formatStatusLine :: StatusLine -> Text
formatStatusLine StatusLine{..} =
Text.pack $
printf
"%s | %s | %d B | %s | page %d/%d"
(filePath fileInfo)
permissions
(fileSize fileInfo)
timestamp
currentPage
maximumPage
where
permissions =
[ flag 'r' $ fileReadable fileInfo
, flag 'w' $ fileWritable fileInfo
, flag 'x' $ fileExecutable fileInfo
]
flag :: Char -> Bool -> Char
flag = bool '-'
timestamp = TimeFormat.formatTime TimeFormat.defaultTimeLocale "%F %T" $ fileMTime fileInfo

View file

@ -1,6 +1,7 @@
module HCatSpec (spec) where module HCatSpec (spec) where
import HCat.Internal import HCat.Internal
import HCat.Screen
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck (prop) import Test.Hspec.QuickCheck (prop)