From 1e526ba1a17b4b56df7775d7ebded041183356a3 Mon Sep 17 00:00:00 2001 From: Alexander Kobjolke Date: Fri, 8 Sep 2023 22:04:25 +0200 Subject: [PATCH] Implement a status line The status line shows information about the shown file, such as size, modification time and permissions. --- hcat.cabal | 2 ++ src/HCat.hs | 30 ++++++++++++++++++++++------ src/HCat/FileInfo.hs | 4 ++-- src/HCat/Internal.hs | 8 ++------ src/HCat/Screen.hs | 8 ++++++++ src/HCat/StatusLine.hs | 44 ++++++++++++++++++++++++++++++++++++++++++ test/spec/HCatSpec.hs | 1 + 7 files changed, 83 insertions(+), 14 deletions(-) create mode 100644 src/HCat/Screen.hs create mode 100644 src/HCat/StatusLine.hs diff --git a/hcat.cabal b/hcat.cabal index d0e182c..c10f21a 100644 --- a/hcat.cabal +++ b/hcat.cabal @@ -20,6 +20,8 @@ library HCat HCat.FileInfo HCat.Internal + HCat.Screen + HCat.StatusLine other-modules: Paths_hcat hs-source-dirs: diff --git a/src/HCat.hs b/src/HCat.hs index 673edd2..e7a3a2b 100644 --- a/src/HCat.hs +++ b/src/HCat.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + module HCat ( runHCat, defaultMain, @@ -9,29 +11,45 @@ import System.IO import Control.Exception qualified as Exception 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 HCat.FileInfo (getFileInfo) import HCat.Internal +import HCat.Screen +import HCat.StatusLine runHCat :: IO () runHCat = do fileNameOrError <- parseArgs <$> Env.getArgs fileName <- eitherToError fileNameOrError content <- TextIO.readFile fileName + fileInfo <- getFileInfo fileName screen <- getTerminalSize 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 [] = pure () -showPages (p : ps) = do +showPages :: Int -> StatusLine -> Pages -> IO () +showPages _ _ [] = pure () +showPages maxWidth statusLine@StatusLine{..} (p : ps) = do TextIO.putStr p - putStr ">>> (n)ext page or (q)uit?" + -- putStr ">>> (n)ext page or (q)uit?" + let s = snippet maxWidth $ formatStatusLine statusLine + TextIO.putStr s hFlush stdout cmd <- getUserCommand case cmd of 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 = either (Exception.throwIO . IOError.userError . show) return diff --git a/src/HCat/FileInfo.hs b/src/HCat/FileInfo.hs index f1cc2d8..3a04a4e 100644 --- a/src/HCat/FileInfo.hs +++ b/src/HCat/FileInfo.hs @@ -2,7 +2,7 @@ -- | FileInfo defines a data type that captures important information about a -- file such as timestamps and permissions. -module HCat.FileInfo (FileInfo, getFileInfo) where +module HCat.FileInfo where import Data.Text (Text) import Data.Text qualified as T @@ -42,4 +42,4 @@ getFileInfo path = do fileWritable = Directory.writable perms fileExecutable = Directory.executable perms filePath = T.pack path - return FileInfo{..} + pure FileInfo{..} diff --git a/src/HCat/Internal.hs b/src/HCat/Internal.hs index e443d2c..df8fdad 100644 --- a/src/HCat/Internal.hs +++ b/src/HCat/Internal.hs @@ -8,6 +8,8 @@ import System.IO import System.Info qualified as SysInfo 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 ["foo"] @@ -54,12 +56,6 @@ wordWrap n text in line : wordWrap n rest | 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 -- onto the screen. -- diff --git a/src/HCat/Screen.hs b/src/HCat/Screen.hs new file mode 100644 index 0000000..e2434e7 --- /dev/null +++ b/src/HCat/Screen.hs @@ -0,0 +1,8 @@ +-- | Types and functions related to the screen +module HCat.Screen where + +data ScreenDimensions = ScreenDimensions + { screenRows :: Int + , screenColumns :: Int + } + deriving (Show) diff --git a/src/HCat/StatusLine.hs b/src/HCat/StatusLine.hs new file mode 100644 index 0000000..322c55d --- /dev/null +++ b/src/HCat/StatusLine.hs @@ -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 diff --git a/test/spec/HCatSpec.hs b/test/spec/HCatSpec.hs index cd8255c..f7d3155 100644 --- a/test/spec/HCatSpec.hs +++ b/test/spec/HCatSpec.hs @@ -1,6 +1,7 @@ module HCatSpec (spec) where import HCat.Internal +import HCat.Screen import Test.Hspec import Test.Hspec.QuickCheck (prop)