76 lines
2 KiB
Haskell
76 lines
2 KiB
Haskell
-- | Internal module in order to facilitate testability.
|
|
module HCat.Internal where
|
|
|
|
import Data.Text (Text)
|
|
import Data.Text qualified as T
|
|
|
|
import System.Process qualified as P
|
|
|
|
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
|
|
--
|
|
-- >>> parseArgs ["foo"]
|
|
-- Right "foo"
|
|
parseArgs :: [String] -> Either String FilePath
|
|
parseArgs args = case args of
|
|
[] -> Left "No filename given!"
|
|
[arg] -> Right arg
|
|
_ -> Left "Only a single file is supported"
|
|
|
|
-- | @chunksOf n@ splits a list into chunks of at most @n@ items.
|
|
--
|
|
-- >>> chunksOf 3 "abcdefgh"
|
|
-- ["abc","def","gh"]
|
|
--
|
|
-- >>> chunksOf 0 "abcdefgh"
|
|
-- []
|
|
--
|
|
-- >>> chunksOf (-1) "abcdefgh"
|
|
-- []
|
|
chunksOf :: Int -> [a] -> [[a]]
|
|
chunksOf _ [] = []
|
|
chunksOf n xs@(_ : _)
|
|
| n <= 0 = []
|
|
| otherwise =
|
|
let (chunk, rest) = splitAt n xs
|
|
in chunk : chunksOf n rest
|
|
|
|
-- | @wordWrap@ splits the given Text if it is longer than the given margin.
|
|
--
|
|
-- >>> :set -XOverloadedStrings
|
|
-- >>> wordWrap 3 "abcdef"
|
|
-- ["abc","def"]
|
|
--
|
|
-- >>> wordWrap 3 "abc"
|
|
-- ["abc"]
|
|
--
|
|
-- >>> wordWrap 3 "ab"
|
|
-- ["ab"]
|
|
wordWrap :: Int -> Text -> [Text]
|
|
wordWrap n text
|
|
| n > 0 && T.length text > n =
|
|
let (line, rest) = T.splitAt 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.
|
|
--
|
|
-- >>> paginate ScreenDimensions{screenRows = 2, screenColumns = 2} "foo bar baz"
|
|
-- ["fo\no \n","ba\nr \n","ba\nz\n"]
|
|
paginate :: ScreenDimensions -> Text -> Pages
|
|
paginate (ScreenDimensions rows cols) =
|
|
fmap T.unlines . chunksOf rows . concatMap (wordWrap cols) . T.lines
|
|
|
|
type Pages = [Page]
|
|
type Page = Text
|
|
|
|
getScreenDimensions :: IO ScreenDimensions
|
|
getScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
|
|
where
|
|
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|