diff options
| -rw-r--r-- | System/Pager.hs | 40 | ||||
| -rw-r--r-- | pager.cabal | 10 | ||||
| -rw-r--r-- | test/main.hs | 9 |
3 files changed, 55 insertions, 4 deletions
diff --git a/System/Pager.hs b/System/Pager.hs index ca80e17..f0b05b4 100644 --- a/System/Pager.hs +++ b/System/Pager.hs @@ -21,20 +21,56 @@ import Data.ByteString.Char8 (unpack) import qualified Data.ByteString.Lazy as Bl import Data.Conduit import Data.Conduit.Binary -import Data.Text (Text) +import Data.List import qualified Data.Monoid (mconcat, mempty) +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import qualified Data.Text.IO as TIO import Safe import System.Directory import System.Exit import System.IO import System.Posix.ByteString import System.Process +import System.Console.Terminfo + +-- |If the user's terminal is long enough to display the (strict) +-- 'Text', just print it. Else, send it to the pager. +-- +-- The text needs to be strict, because the function counts the number +-- of lines in the text. (This is also why it needs to be text, and not +-- a bytestring, because Text has stuff like line-counting). +printOrPage :: Text -> IO () +printOrPage text = + do terminal <- setupTermFromEnv + let linesInTerminal = + getCapability terminal termLines + columnsInTerminal = + getCapability terminal termColumns + linesInText = length (T.lines text) + columnsInText = + last (sort (fmap T.length (T.lines text))) + usePager = + case (columnsInTerminal,linesInTerminal) of + (Nothing,_) -> True + (_,Nothing) -> True + (Just x,Just y) + | or [x <= columnsInText,y <= linesInText] -> True + | otherwise -> False + if usePager + then sendToPagerStrict (TE.encodeUtf8 text) + else TIO.putStr text -- |Send a lazy 'Bl.ByteString' to the user's @$PAGER@. sendToPager :: Bl.ByteString -> IO () -sendToPager bytes = sendToPagerConduit (sourceLbs bytes) +sendToPager bytes = + sendToPagerConduit (sourceLbs bytes) + +-- |Send a strict 'B.ByteString' to the user's @$PAGER@. +sendToPagerStrict :: B.ByteString -> IO () +sendToPagerStrict bytes = + sendToPagerConduit (sourceLbs (Bl.fromStrict bytes)) -- |This finds the user's @$PAGER@. This will fail if: -- diff --git a/pager.cabal b/pager.cabal index b30a78e..cc42fca 100644 --- a/pager.cabal +++ b/pager.cabal @@ -1,9 +1,13 @@ name: pager -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Open up a pager, like 'less' or 'more' description: This opens up the user's $PAGER. On Linux, this is usually called @less@. On the various BSDs, this is usually @more@. + . + CHANGES + . + [0.1.1.0] Add @printOrPage@ function and @sendToPagerStrict@ function. homepage: https://github.com/pharpend/pager license: BSD2 license-file: LICENSE @@ -27,7 +31,7 @@ source-repository head source-repository this type: git location: https://github.com/pharpend/pager.git - tag: 0.1.0.0 + tag: 0.1.1.0 library other-extensions: @@ -47,6 +51,7 @@ library , resourcet , safe , unix + , terminfo , text , transformers @@ -60,4 +65,5 @@ executable hs-pager-test-pager , bytestring , conduit-extra , pager + , text diff --git a/test/main.hs b/test/main.hs index 67ced70..997d209 100644 --- a/test/main.hs +++ b/test/main.hs @@ -1,8 +1,13 @@ import qualified Data.ByteString.Lazy as B +import qualified Data.Text.IO as TIO import Data.Conduit.Binary import Paths_pager import System.Pager +testPrintOrPage :: FilePath -> IO () +testPrintOrPage fnom = + TIO.readFile fnom >>= printOrPage + testConduit :: FilePath -> IO () testConduit fnom = sendToPagerConduit (sourceFile fnom) @@ -10,6 +15,7 @@ testConduit fnom = test :: FilePath -> IO () test fp = B.readFile fp >>= sendToPager +main :: IO () main = do fnom <- getDataFileName "LICENSE" putStrLn "Hit Return to start the conduit-free test" @@ -18,3 +24,6 @@ main = putStrLn "Hit Return to start the conduit test" _ <- getLine testConduit fnom + putStrLn "Hit Return to start the printOrPage test (no conduits)" + _ <- getLine + testPrintOrPage fnom |