{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, DeriveDataTypeable #-}
module System.Process.Pager
(pageWriter
,pageText
,PagerException(..))
where
import Stack.Prelude
import System.Directory (findExecutable)
import System.Environment (lookupEnv)
import System.Process (createProcess,shell,waitForProcess,StdStream (CreatePipe)
,CreateProcess(std_in, close_fds, delegate_ctlc))
import System.IO (stdout)
import qualified Data.Text.IO as T
pageWriter :: (Handle -> IO ()) -> IO ()
pageWriter writer =
do mpager <- lookupEnv "PAGER" `orElse`
findExecutable "less" `orElse`
findExecutable "more"
case mpager of
Just pager ->
do (Just h,_,_,procHandle) <- createProcess (shell pager)
{std_in = CreatePipe
,close_fds = True
,delegate_ctlc = True}
(_::Either IOException ()) <- try (do writer h
hClose h)
exit <- waitForProcess procHandle
case exit of
ExitSuccess -> return ()
ExitFailure n -> throwIO (PagerExitFailure pager n)
return ()
Nothing -> writer stdout
where
orElse a b = maybe b (return . Just) =<< a
pageText :: Text -> IO ()
pageText = pageWriter . flip T.hPutStr
data PagerException = PagerExitFailure FilePath Int
deriving Typeable
instance Show PagerException where
show (PagerExitFailure p n) = "Pager (`" ++ p ++ "') exited with non-zero status: " ++ show n
instance Exception PagerException