pager-0.1.1.0/0000755000000000000000000000000012525707602011141 5ustar0000000000000000pager-0.1.1.0/LICENSE0000644000000000000000000000243212525707602012147 0ustar0000000000000000Copyright (c) 2015, Peter Harpending All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pager-0.1.1.0/pager.cabal0000644000000000000000000000321512525707602013224 0ustar0000000000000000name: pager 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 author: Peter Harpending maintainer: peter@harpending.org bug-reports: https://github.com/pharpend/pager copyright: Copyright (c) 2015, Peter Harpending. category: Data, System, Text build-type: Simple cabal-version: >=1.10 extra-source-files: README.md LICENSE data-files: LICENSE source-repository head type: git location: https://github.com/pharpend/pager.git source-repository this type: git location: https://github.com/pharpend/pager.git tag: 0.1.1.0 library other-extensions: LambdaCase MultiWayIf OverloadedStrings default-language: Haskell2010 exposed-modules: System.Pager build-depends: base ==4.* , bytestring , conduit >=1.2.3 , conduit-extra , directory , process , resourcet , safe , unix , terminfo , text , transformers executable hs-pager-test-pager default-language: Haskell2010 hs-source-dirs: test other-modules: Paths_pager main-is: main.hs build-depends: base ==4.* , bytestring , conduit-extra , pager , text pager-0.1.1.0/README.md0000644000000000000000000000074112525707602012422 0ustar0000000000000000pager ===== This is a Haskell library to open up the user's `$PAGER` with some text. On Linux, the pager is usually called `less`. On the various *BSD's, the pager is called `more`. The pager doesn't notify people or anything - it takes long output and presents it in pages. This library is licensed under the FreeBSD license (the 2-clause BSD license). Read the LICENSE file for details. Contact ------- * Email: `peter@harpending.org` * IRC: `pharpend` on FreeNode and OFTC pager-0.1.1.0/Setup.hs0000644000000000000000000000005612525707602012576 0ustar0000000000000000import Distribution.Simple main = defaultMain pager-0.1.1.0/System/0000755000000000000000000000000012525707602012425 5ustar0000000000000000pager-0.1.1.0/System/Pager.hs0000644000000000000000000001135012525707602014017 0ustar0000000000000000{-# LANGUAGE MultiWayIf, LambdaCase, OverloadedStrings, RankNTypes #-} -- | -- Module : System.Pager -- Description : Send stuff to the user's $PAGER. -- Copyright : Copyright (c) 2015, Peter Harpending. -- License : BSD2 -- Maintainer : Peter Harpending -- Stability : experimental -- Portability : Tested with GHC on Linux and FreeBSD -- module System.Pager where import Control.Monad (forM) import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Char8 (unpack) import qualified Data.ByteString.Lazy as Bl import Data.Conduit import Data.Conduit.Binary 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) -- |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: -- -- * There is no @$PATH@ variable -- * The user doesn't have a @less@ or @more@ installed, and hasn't -- specified an alternate program via @$PAGER@. -- findPager :: IO ByteString findPager = getEnv "PAGER" >>= \case Just x -> return x Nothing -> getEnv "PATH" >>= \case Nothing -> fail "There is no $PATH, so I can't see if 'less' or 'more' is installed." Just p -> do let pathText = TE.decodeUtf8 p pathPieces = T.splitOn ":" pathText searchForLess <- fmap mconcat (forM pathPieces (\pathPiece -> do dirExists <- doesDirectoryExist (T.unpack pathPiece) filesInDir <- if | dirExists -> getDirectoryContents (T.unpack pathPiece) | otherwise -> return mempty return (filter (\x -> (x == "less") || (x == "more")) filesInDir))) if | searchForLess == mempty -> fail "There doesn't appear to be any pager installed." | elem "less" searchForLess -> return "less" | otherwise -> return "more" -- |This is what 'sendToPager' uses on the back end. It takes a -- 'Producer', from "Data.Conduit", and then sends the produced bytes to -- the pager's stdin. sendToPagerConduit :: Producer (ResourceT IO) ByteString -> IO () sendToPagerConduit producer = do pager <- fmap unpack findPager ((Just stdinH),_,(Just stderrH),ph) <- createProcess ((shell pager) {std_in = CreatePipe ,std_err = CreatePipe}) runResourceT (connect producer (sinkHandle stdinH)) hClose stdinH exitCode <- waitForProcess ph case exitCode of ExitFailure i -> do errContents <- hGetContents stderrH fail (unlines [mappend "Pager exited with exit code " (show i) ,errContents]) ExitSuccess -> return () pager-0.1.1.0/test/0000755000000000000000000000000012525707602012120 5ustar0000000000000000pager-0.1.1.0/test/main.hs0000644000000000000000000000137412525707602013405 0ustar0000000000000000import 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) 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" _ <- getLine test fnom putStrLn "Hit Return to start the conduit test" _ <- getLine testConduit fnom putStrLn "Hit Return to start the printOrPage test (no conduits)" _ <- getLine testPrintOrPage fnom