module System.Process.PagerEditor
(
pageWriter
,pageByteString
,pageBuilder
,pageFile
,pageString
,PagerException(..)
,editFile
,editReaderWriter
,editByteString
,editString
,EditorException(..))
where
import Control.Exception (try,IOException,throwIO,Exception)
import Data.ByteString.Lazy (ByteString,hPut,readFile)
import Data.ByteString.Builder (Builder,stringUtf8,hPutBuilder)
import Data.Typeable (Typeable)
import System.Directory (findExecutable)
import System.Environment (lookupEnv)
import System.Exit (ExitCode(..))
import System.FilePath ((</>))
import System.Process (createProcess,shell,proc,waitForProcess,StdStream (CreatePipe)
,CreateProcess(std_in, close_fds, delegate_ctlc))
import System.IO (hClose,Handle,hPutStr,readFile,withFile,IOMode(WriteMode),stdout)
import System.IO.Temp (withSystemTempDirectory)
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
pageByteString :: ByteString -> IO ()
pageByteString = pageWriter . flip hPut
pageBuilder :: Builder -> IO ()
pageBuilder = pageWriter . flip hPutBuilder
pageFile :: FilePath -> IO ()
pageFile p = pageByteString =<< Data.ByteString.Lazy.readFile p
pageString :: String -> IO ()
pageString = pageBuilder . stringUtf8
editFile :: FilePath -> IO ()
editFile path =
do meditor <- lookupEnv "VISUAL" `orElse`
lookupEnv "EDITOR" `orElse`
findExecutable "nano" `orElse`
findExecutable "pico" `orElse`
findExecutable "vi"
case meditor of
Just editor ->
do (_,_,_,procHandle) <- createProcess (proc "sh" ["-c", editor ++ " \"$1\"", "sh", path])
{close_fds = True,delegate_ctlc = True}
exitCode <- waitForProcess procHandle
case exitCode of
ExitSuccess -> return ()
ExitFailure n -> throwIO (EditorExitFailure editor n)
Nothing -> throwIO EditorNotFound
editReaderWriter :: forall a. String -> (Handle -> IO ()) -> (FilePath -> IO a) -> IO a
editReaderWriter filename writer reader =
withSystemTempDirectory ""
(\p -> do let p' = p </> filename
withFile p' WriteMode writer
editFile p'
reader p')
editByteString :: String -> ByteString -> IO ByteString
editByteString f s = editReaderWriter f (`hPut` s) Data.ByteString.Lazy.readFile
editString :: String -> String -> IO String
editString f s = editReaderWriter f (`hPutStr` s) System.IO.readFile
orElse :: (Monad m) => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
orElse a b = do m <- a
case m of
Just _ -> return m
Nothing -> b
data PagerException = PagerNotFound
| PagerExitFailure FilePath Int
deriving Typeable
instance Show PagerException where
show PagerNotFound = "No pager found (tried $PAGER, `less`, and `more`.)"
show (PagerExitFailure p n) = "Pager (`" ++ p ++ "') exited with non-zero status: " ++ show n
instance Exception PagerException
data EditorException = EditorNotFound
| EditorExitFailure FilePath Int
deriving Typeable
instance Show EditorException where
show EditorNotFound = "No editor found (tried $VISUAL, $PAGER, `nano`, `pico`, and `vi`.)"
show (EditorExitFailure p n) = "Editor (`" ++ p ++ "') exited with non-zero status: " ++ show n
instance Exception EditorException