{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, DeriveDataTypeable #-}
module System.Process.PagerEditor
(
pageWriter
,pageByteString
,pageText
,pageBuilder
,pageFile
,pageString
,PagerException(..)
,editFile
,editReaderWriter
,editByteString
,editString
,EditorException(..))
where
import qualified Data.ByteString.Lazy (readFile)
import Data.ByteString.Lazy (hPut)
import Stack.Prelude
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 (hPutStr,readFile,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
pageByteString :: LByteString -> IO ()
pageByteString = pageWriter . flip hPut
pageText :: Text -> IO ()
pageText = pageWriter . flip T.hPutStr
pageBuilder :: Builder -> IO ()
pageBuilder = pageWriter . flip hPutBuilder
pageFile :: FilePath -> IO ()
pageFile p = pageByteString =<< Data.ByteString.Lazy.readFile p
pageString :: String -> IO ()
pageString = pageBuilder . fromString
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 -> LByteString -> IO LByteString
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