{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE ScopedTypeVariables, RankNTypes, DeriveDataTypeable #-}

-- | Run external pagers (@$PAGER@, @less@, @more@).

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

-- | Run pager, providing a function that writes to the pager's input.

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

-- | Run pager to display a 'Text'

pageText :: Text -> IO ()

pageText = pageWriter . flip T.hPutStr

-- | Exception running pager.

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